Upgrade Module::Install to 1.06
authorEmmanuel Lacour <elacour@easter-eggs.com>
Wed, 12 Mar 2014 16:44:44 +0000 (17:44 +0100)
committerEmmanuel Lacour <elacour@easter-eggs.com>
Wed, 12 Mar 2014 16:44:44 +0000 (17:44 +0100)
13 files changed:
MANIFEST
inc/Module/Install.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
inc/Module/Install/Fetch.pm
inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/RTx.pm
inc/Module/Install/RTx/Factory.pm [new file with mode: 0644]
inc/Module/Install/ReadmeFromPod.pm [new file with mode: 0644]
inc/Module/Install/Substitute.pm [new file with mode: 0644]
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm

index 838b0c6..f7b955e 100644 (file)
--- a/MANIFEST
+++ b/MANIFEST
@@ -9,7 +9,10 @@ inc/Module/Install/Can.pm
 inc/Module/Install/Fetch.pm
 inc/Module/Install/Makefile.pm
 inc/Module/Install/Metadata.pm
 inc/Module/Install/Fetch.pm
 inc/Module/Install/Makefile.pm
 inc/Module/Install/Metadata.pm
+inc/Module/Install/ReadmeFromPod.pm
 inc/Module/Install/RTx.pm
 inc/Module/Install/RTx.pm
+inc/Module/Install/RTx/Factory.pm
+inc/Module/Install/Substitute.pm
 inc/Module/Install/Win32.pm
 inc/Module/Install/WriteAll.pm
 lib/RT/Extension/SearchResults/XLS.pm
 inc/Module/Install/Win32.pm
 inc/Module/Install/WriteAll.pm
 lib/RT/Extension/SearchResults/XLS.pm
index 8ee839d..4ecf46b 100644 (file)
@@ -31,7 +31,7 @@ BEGIN {
        # This is not enforced yet, but will be some time in the next few
        # releases once we can make sure it won't clash with custom
        # Module::Install extensions.
        # This is not enforced yet, but will be some time in the next few
        # releases once we can make sure it won't clash with custom
        # Module::Install extensions.
-       $VERSION = '1.00';
+       $VERSION = '1.06';
 
        # Storage for the pseudo-singleton
        $MAIN    = undef;
 
        # Storage for the pseudo-singleton
        $MAIN    = undef;
@@ -451,7 +451,7 @@ sub _version ($) {
 }
 
 sub _cmp ($$) {
 }
 
 sub _cmp ($$) {
-       _version($_[0]) <=> _version($_[1]);
+       _version($_[1]) <=> _version($_[2]);
 }
 
 # Cloned from Params::Util::_CLASS
 }
 
 # Cloned from Params::Util::_CLASS
@@ -467,4 +467,4 @@ sub _CLASS ($) {
 
 1;
 
 
 1;
 
-# Copyright 2008 - 2010 Adam Kennedy.
+# Copyright 2008 - 2012 Adam Kennedy.
index b55bda3..802844a 100644 (file)
@@ -4,7 +4,7 @@ package Module::Install::Base;
 use strict 'vars';
 use vars qw{$VERSION};
 BEGIN {
 use strict 'vars';
 use vars qw{$VERSION};
 BEGIN {
-       $VERSION = '1.00';
+       $VERSION = '1.06';
 }
 
 # Suspend handler for "redefined" warnings
 }
 
 # Suspend handler for "redefined" warnings
index 71ccc27..22167b8 100644 (file)
@@ -3,13 +3,12 @@ package Module::Install::Can;
 
 use strict;
 use Config                ();
 
 use strict;
 use Config                ();
-use File::Spec            ();
 use ExtUtils::MakeMaker   ();
 use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
 use ExtUtils::MakeMaker   ();
 use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '1.00';
+       $VERSION = '1.06';
        @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
 }
        @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
 }
@@ -29,7 +28,7 @@ sub can_use {
        eval { require $mod; $pkg->VERSION($ver || 0); 1 };
 }
 
        eval { require $mod; $pkg->VERSION($ver || 0); 1 };
 }
 
-# check if we can run some command
+# Check if we can run some command
 sub can_run {
        my ($self, $cmd) = @_;
 
 sub can_run {
        my ($self, $cmd) = @_;
 
@@ -38,14 +37,88 @@ sub can_run {
 
        for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
                next if $dir eq '';
 
        for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
                next if $dir eq '';
-               my $abs = File::Spec->catfile($dir, $_[1]);
+               require File::Spec;
+               my $abs = File::Spec->catfile($dir, $cmd);
                return $abs if (-x $abs or $abs = MM->maybe_command($abs));
        }
 
        return;
 }
 
                return $abs if (-x $abs or $abs = MM->maybe_command($abs));
        }
 
        return;
 }
 
-# can we locate a (the) C compiler
+# Can our C compiler environment build XS files
+sub can_xs {
+       my $self = shift;
+
+       # Ensure we have the CBuilder module
+       $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
+
+       # Do we have the configure_requires checker?
+       local $@;
+       eval "require ExtUtils::CBuilder;";
+       if ( $@ ) {
+               # They don't obey configure_requires, so it is
+               # someone old and delicate. Try to avoid hurting
+               # them by falling back to an older simpler test.
+               return $self->can_cc();
+       }
+
+       # Do we have a working C compiler
+       my $builder = ExtUtils::CBuilder->new(
+               quiet => 1,
+       );
+       unless ( $builder->have_compiler ) {
+               # No working C compiler
+               return 0;
+       }
+
+       # Write a C file representative of what XS becomes
+       require File::Temp;
+       my ( $FH, $tmpfile ) = File::Temp::tempfile(
+               "compilexs-XXXXX",
+               SUFFIX => '.c',
+       );
+       binmode $FH;
+       print $FH <<'END_C';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+    return 0;
+}
+
+int boot_sanexs() {
+    return 1;
+}
+
+END_C
+       close $FH;
+
+       # Can the C compiler access the same headers XS does
+       my @libs   = ();
+       my $object = undef;
+       eval {
+               local $^W = 0;
+               $object = $builder->compile(
+                       source => $tmpfile,
+               );
+               @libs = $builder->link(
+                       objects     => $object,
+                       module_name => 'sanexs',
+               );
+       };
+       my $result = $@ ? 0 : 1;
+
+       # Clean up all the build files
+       foreach ( $tmpfile, $object, @libs ) {
+               next unless defined $_;
+               1 while unlink;
+       }
+
+       return $result;
+}
+
+# Can we locate a (the) C compiler
 sub can_cc {
        my $self   = shift;
        my @chunks = split(/ /, $Config::Config{cc}) or return;
 sub can_cc {
        my $self   = shift;
        my @chunks = split(/ /, $Config::Config{cc}) or return;
@@ -78,4 +151,4 @@ if ( $^O eq 'cygwin' ) {
 
 __END__
 
 
 __END__
 
-#line 156
+#line 236
index ec1f106..bee0c4f 100644 (file)
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '1.00';
+       $VERSION = '1.06';
        @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
 }
        @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
 }
index 5dfd0e9..7052f36 100644 (file)
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '1.00';
+       $VERSION = '1.06';
        @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
 }
        @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
 }
@@ -215,18 +215,22 @@ sub write {
        require ExtUtils::MakeMaker;
 
        if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
        require ExtUtils::MakeMaker;
 
        if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
-               # MakeMaker can complain about module versions that include
-               # an underscore, even though its own version may contain one!
-               # Hence the funny regexp to get rid of it.  See RT #35800
-               # for details.
-               my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
-               $self->build_requires(     'ExtUtils::MakeMaker' => $v );
-               $self->configure_requires( 'ExtUtils::MakeMaker' => $v );
+               # This previous attempted to inherit the version of
+               # ExtUtils::MakeMaker in use by the module author, but this
+               # was found to be untenable as some authors build releases
+               # using future dev versions of EU:MM that nobody else has.
+               # Instead, #toolchain suggests we use 6.59 which is the most
+               # stable version on CPAN at time of writing and is, to quote
+               # ribasushi, "not terminally fucked, > and tested enough".
+               # TODO: We will now need to maintain this over time to push
+               # the version up as new versions are released.
+               $self->build_requires(     'ExtUtils::MakeMaker' => 6.59 );
+               $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
        } else {
                # Allow legacy-compatibility with 5.005 by depending on the
                # most recent EU:MM that supported 5.005.
        } else {
                # Allow legacy-compatibility with 5.005 by depending on the
                # most recent EU:MM that supported 5.005.
-               $self->build_requires(     'ExtUtils::MakeMaker' => 6.42 );
-               $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
+               $self->build_requires(     'ExtUtils::MakeMaker' => 6.36 );
+               $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
        }
 
        # Generate the MakeMaker params
        }
 
        # Generate the MakeMaker params
@@ -241,7 +245,6 @@ in a module, and provide its file path via 'version_from' (or
 'all_from' if you prefer) in Makefile.PL.
 EOT
 
 'all_from' if you prefer) in Makefile.PL.
 EOT
 
-       $DB::single = 1;
        if ( $self->tests ) {
                my @tests = split ' ', $self->tests;
                my %seen;
        if ( $self->tests ) {
                my @tests = split ' ', $self->tests;
                my %seen;
@@ -412,4 +415,4 @@ sub postamble {
 
 __END__
 
 
 __END__
 
-#line 541
+#line 544
index cfe45b3..58430f3 100644 (file)
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '1.00';
+       $VERSION = '1.06';
        @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
 }
        @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
 }
@@ -151,15 +151,21 @@ sub install_as_site   { $_[0]->installdirs('site')   }
 sub install_as_vendor { $_[0]->installdirs('vendor') }
 
 sub dynamic_config {
 sub install_as_vendor { $_[0]->installdirs('vendor') }
 
 sub dynamic_config {
-       my $self = shift;
-       unless ( @_ ) {
-               warn "You MUST provide an explicit true/false value to dynamic_config\n";
-               return $self;
+       my $self  = shift;
+       my $value = @_ ? shift : 1;
+       if ( $self->{values}->{dynamic_config} ) {
+               # Once dynamic we never change to static, for safety
+               return 0;
        }
        }
-       $self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
+       $self->{values}->{dynamic_config} = $value ? 1 : 0;
        return 1;
 }
 
        return 1;
 }
 
+# Convenience command
+sub static_config {
+       shift->dynamic_config(0);
+}
+
 sub perl_version {
        my $self = shift;
        return $self->{values}->{perl_version} unless @_;
 sub perl_version {
        my $self = shift;
        return $self->{values}->{perl_version} unless @_;
@@ -170,7 +176,7 @@ sub perl_version {
        # Normalize the version
        $version = $self->_perl_version($version);
 
        # Normalize the version
        $version = $self->_perl_version($version);
 
-       # We don't support the reall old versions
+       # We don't support the really old versions
        unless ( $version >= 5.005 ) {
                die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
        }
        unless ( $version >= 5.005 ) {
                die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
        }
@@ -515,6 +521,7 @@ sub __extract_license {
                'GNU Free Documentation license'     => 'unrestricted', 1,
                'GNU Affero General Public License'  => 'open_source',  1,
                '(?:Free)?BSD license'               => 'bsd',          1,
                'GNU Free Documentation license'     => 'unrestricted', 1,
                'GNU Affero General Public License'  => 'open_source',  1,
                '(?:Free)?BSD license'               => 'bsd',          1,
+               'Artistic license 2\.0'              => 'artistic_2',   1,
                'Artistic license'                   => 'artistic',     1,
                'Apache (?:Software )?license'       => 'apache',       1,
                'GPL'                                => 'gpl',          1,
                'Artistic license'                   => 'artistic',     1,
                'Apache (?:Software )?license'       => 'apache',       1,
                'GPL'                                => 'gpl',          1,
@@ -550,9 +557,9 @@ sub license_from {
 
 sub _extract_bugtracker {
        my @links   = $_[0] =~ m#L<(
 
 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
+        https?\Q://rt.cpan.org/\E[^>]+|
+        https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
+        https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
         )>#gx;
        my %links;
        @links{@links}=();
         )>#gx;
        my %links;
        @links{@links}=();
@@ -581,7 +588,7 @@ sub bugtracker_from {
 sub requires_from {
        my $self     = shift;
        my $content  = Module::Install::_readperl($_[0]);
 sub requires_from {
        my $self     = shift;
        my $content  = Module::Install::_readperl($_[0]);
-       my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+       my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
        while ( @requires ) {
                my $module  = shift @requires;
                my $version = shift @requires;
        while ( @requires ) {
                my $module  = shift @requires;
                my $version = shift @requires;
index 20a354b..ac04c79 100644 (file)
@@ -8,13 +8,13 @@ no warnings 'once';
 
 use Module::Install::Base;
 use base 'Module::Install::Base';
 
 use Module::Install::Base;
 use base 'Module::Install::Base';
-our $VERSION = '0.24';
+our $VERSION = '0.32';
 
 use FindBin;
 use File::Glob     ();
 use File::Basename ();
 
 
 use FindBin;
 use File::Glob     ();
 use File::Basename ();
 
-my @DIRS = qw(etc lib html bin sbin po var);
+my @DIRS = qw(etc lib html static bin sbin po var);
 my @INDEX_DIRS = qw(lib bin sbin);
 
 sub RTx {
 my @INDEX_DIRS = qw(lib bin sbin);
 
 sub RTx {
@@ -42,15 +42,16 @@ sub RTx {
         $INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
     } else {
         local @INC = (
         $INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
     } else {
         local @INC = (
-            @INC,
             $ENV{RTHOME} ? ( $ENV{RTHOME}, "$ENV{RTHOME}/lib" ) : (),
             $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";
         );
         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";
         }
     }
             push @INC, $_, "$_/rt3/lib", "$_/lib/rt3", "$_/lib";
         }
     }
@@ -59,11 +60,13 @@ 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;
     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;
-    $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
-    $RT::LocalLibPath  ||= "$RT::LocalPath/lib";
+    $RT::LocalVarPath    ||= $RT::VarPath;
+    $RT::LocalPoPath     ||= $RT::LocalLexiconPath;
+    $RT::LocalHtmlPath   ||= $RT::MasonComponentRoot;
+    $RT::LocalStaticPath ||= $RT::StaticPath;
+    $RT::LocalLibPath    ||= "$RT::LocalPath/lib";
 
     my $with_subdirs = $ENV{WITH_SUBDIRS};
     @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
 
     my $with_subdirs = $ENV{WITH_SUBDIRS};
     @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
@@ -127,23 +130,13 @@ install ::
 
     my %has_etc;
     if ( File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*") ) {
 
     my %has_etc;
     if ( File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*") ) {
-
-        # got schema, load factory module
         $has_etc{schema}++;
         $has_etc{schema}++;
-        $self->load('RTxFactory');
-        $self->postamble(<< ".");
-factory ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
-
-dropdb ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
-
-.
     }
     if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) {
         $has_etc{acl}++;
     }
     if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
     }
     if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) {
         $has_etc{acl}++;
     }
     if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
+    if ( -d 'etc/upgrade/' )    { $has_etc{upgrade}++; }
 
     $self->postamble("$postamble\n");
     unless ( $subdirs{'lib'} ) {
 
     $self->postamble("$postamble\n");
     unless ( $subdirs{'lib'} ) {
@@ -162,30 +155,65 @@ dropdb ::
         print "For first-time installation, type 'make initdb'.\n";
         my $initdb = '';
         $initdb .= <<"." if $has_etc{schema};
         print "For first-time installation, type 'make initdb'.\n";
         my $initdb = '';
         $initdb .= <<"." if $has_etc{schema};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema \$(NAME) \$(VERSION)))"
 .
         $initdb .= <<"." if $has_etc{acl};
 .
         $initdb .= <<"." if $has_etc{acl};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl \$(NAME) \$(VERSION)))"
 .
         $initdb .= <<"." if $has_etc{initialdata};
 .
         $initdb .= <<"." if $has_etc{initialdata};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert \$(NAME) \$(VERSION)))"
 .
         $self->postamble("initdb ::\n$initdb\n");
         $self->postamble("initialize-database ::\n$initdb\n");
 .
         $self->postamble("initdb ::\n$initdb\n");
         $self->postamble("initialize-database ::\n$initdb\n");
+        if ($has_etc{upgrade}) {
+            print "To upgrade from a previous version of this extension, use 'make upgrade-database'\n";
+            my $upgradedb = qq|\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(upgrade \$(NAME) \$(VERSION)))"\n|;
+            $self->postamble("upgrade-database ::\n$upgradedb\n");
+            $self->postamble("upgradedb ::\n$upgradedb\n");
+        }
     }
 }
 
     }
 }
 
-sub RTxInit {
-    unshift @INC, substr( delete( $INC{'RT.pm'} ), 0, -5 ) if $INC{'RT.pm'};
-    require RT;
-    RT::LoadConfig();
-    RT::ConnectToDatabase();
+# 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);
 
 
-    die "Cannot load RT" unless $RT::Handle and $RT::DatabaseType;
+    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__
 
 }
 
 1;
 
 __END__
 
-#line 302
+#line 336
diff --git a/inc/Module/Install/RTx/Factory.pm b/inc/Module/Install/RTx/Factory.pm
new file mode 100644 (file)
index 0000000..6776688
--- /dev/null
@@ -0,0 +1,53 @@
+#line 1
+package Module::Install::RTx::Factory;
+use Module::Install::Base; @ISA = qw(Module::Install::Base);
+
+use strict;
+use File::Basename ();
+
+sub RTxInitDB {
+    my ($self, $action, $name, $version) = @_;
+
+    unshift @INC, substr(delete($INC{'RT.pm'}), 0, -5) if $INC{'RT.pm'};
+
+    require RT;
+    unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
+
+    $RT::SbinPath ||= $RT::LocalPath;
+    $RT::SbinPath =~ s/local$/sbin/;
+
+    foreach my $file ($RT::CORE_CONFIG_FILE, $RT::SITE_CONFIG_FILE) {
+        next if !-e $file or -r $file;
+        die "No permission to read $file\n-- please re-run $0 with suitable privileges.\n";
+    }
+
+    RT::LoadConfig();
+
+    require RT::System;
+
+    my $lib_path = File::Basename::dirname($INC{'RT.pm'});
+    my @args = ("-Ilib");
+    push @args, "-I$RT::LocalPath/lib" if $RT::LocalPath;
+    push @args, (
+        "-I$lib_path",
+        "$RT::SbinPath/rt-setup-database",
+        "--action"      => $action,
+        ($action eq 'upgrade' ? () : ("--datadir"     => "etc")),
+        (($action eq 'insert') ? ("--datafile"    => "etc/initialdata") : ()),
+        "--dba"         => $RT::DatabaseAdmin || $RT::DatabaseUser,
+        "--prompt-for-dba-password" => '',
+        (RT::System->can('AddUpgradeHistory') ? ("--package" => $name, "--ext-version" => $version) : ()),
+    );
+    # If we're upgrading against an RT which isn't at least 4.2 (has
+    # AddUpgradeHistory) then pass --package.  Upgrades against later RT
+    # releases will pick up --package from AddUpgradeHistory.
+    if ($action eq 'upgrade' and
+        not RT::System->can('AddUpgradeHistory')) {
+        push @args, "--package" => $name;
+    }
+
+    print "$^X @args\n";
+    (system($^X, @args) == 0) or die "...returned with error: $?\n";
+}
+
+1;
diff --git a/inc/Module/Install/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
new file mode 100644 (file)
index 0000000..b5e03c3
--- /dev/null
@@ -0,0 +1,138 @@
+#line 1
+package Module::Install::ReadmeFromPod;
+
+use 5.006;
+use strict;
+use warnings;
+use base qw(Module::Install::Base);
+use vars qw($VERSION);
+
+$VERSION = '0.22';
+
+sub readme_from {
+  my $self = shift;
+  return unless $self->is_admin;
+
+  # Input file
+  my $in_file  = shift || $self->_all_from
+    or die "Can't determine file to make readme_from";
+
+  # Get optional arguments
+  my ($clean, $format, $out_file, $options);
+  my $args = shift;
+  if ( ref $args ) {
+    # Arguments are in a hashref
+    if ( ref($args) ne 'HASH' ) {
+      die "Expected a hashref but got a ".ref($args)."\n";
+    } else {
+      $clean    = $args->{'clean'};
+      $format   = $args->{'format'};
+      $out_file = $args->{'output_file'};
+      $options  = $args->{'options'};
+    }
+  } else {
+    # Arguments are in a list
+    $clean    = $args;
+    $format   = shift;
+    $out_file = shift;
+    $options  = \@_;
+  }
+
+  # Default values;
+  $clean  ||= 0;
+  $format ||= 'txt';
+
+  # Generate README
+  print "readme_from $in_file to $format\n";
+  if ($format =~ m/te?xt/) {
+    $out_file = $self->_readme_txt($in_file, $out_file, $options);
+  } elsif ($format =~ m/html?/) {
+    $out_file = $self->_readme_htm($in_file, $out_file, $options);
+  } elsif ($format eq 'man') {
+    $out_file = $self->_readme_man($in_file, $out_file, $options);
+  } elsif ($format eq 'pdf') {
+    $out_file = $self->_readme_pdf($in_file, $out_file, $options);
+  }
+
+  if ($clean) {
+    $self->clean_files($out_file);
+  }
+
+  return 1;
+}
+
+
+sub _readme_txt {
+  my ($self, $in_file, $out_file, $options) = @_;
+  $out_file ||= 'README';
+  require Pod::Text;
+  my $parser = Pod::Text->new( @$options );
+  open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
+  $parser->output_fh( *$out_fh );
+  $parser->parse_file( $in_file );
+  close $out_fh;
+  return $out_file;
+}
+
+
+sub _readme_htm {
+  my ($self, $in_file, $out_file, $options) = @_;
+  $out_file ||= 'README.htm';
+  require Pod::Html;
+  Pod::Html::pod2html(
+    "--infile=$in_file",
+    "--outfile=$out_file",
+    @$options,
+  );
+  # Remove temporary files if needed
+  for my $file ('pod2htmd.tmp', 'pod2htmi.tmp') {
+    if (-e $file) {
+      unlink $file or warn "Warning: Could not remove file '$file'.\n$!\n";
+    }
+  }
+  return $out_file;
+}
+
+
+sub _readme_man {
+  my ($self, $in_file, $out_file, $options) = @_;
+  $out_file ||= 'README.1';
+  require Pod::Man;
+  my $parser = Pod::Man->new( @$options );
+  $parser->parse_from_file($in_file, $out_file);
+  return $out_file;
+}
+
+
+sub _readme_pdf {
+  my ($self, $in_file, $out_file, $options) = @_;
+  $out_file ||= 'README.pdf';
+  eval { require App::pod2pdf; }
+    or die "Could not generate $out_file because pod2pdf could not be found\n";
+  my $parser = App::pod2pdf->new( @$options );
+  $parser->parse_from_file($in_file);
+  open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
+  select $out_fh;
+  $parser->output;
+  select STDOUT;
+  close $out_fh;
+  return $out_file;
+}
+
+
+sub _all_from {
+  my $self = shift;
+  return unless $self->admin->{extensions};
+  my ($metadata) = grep {
+    ref($_) eq 'Module::Install::Metadata';
+  } @{$self->admin->{extensions}};
+  return unless $metadata;
+  return $metadata->{values}{all_from} || '';
+}
+
+'Readme!';
+
+__END__
+
+#line 254
+
diff --git a/inc/Module/Install/Substitute.pm b/inc/Module/Install/Substitute.pm
new file mode 100644 (file)
index 0000000..56af7fe
--- /dev/null
@@ -0,0 +1,131 @@
+#line 1
+package Module::Install::Substitute;
+
+use strict;
+use warnings;
+use 5.008; # I don't care much about earlier versions
+
+use Module::Install::Base;
+our @ISA = qw(Module::Install::Base);
+
+our $VERSION = '0.03';
+
+require File::Temp;
+require File::Spec;
+require Cwd;
+
+#line 89
+
+sub substitute
+{
+       my $self = shift;
+       $self->{__subst} = shift;
+       $self->{__option} = {};
+       if( UNIVERSAL::isa( $_[0], 'HASH' ) ) {
+               my $opts = shift;
+               while( my ($k,$v) = each( %$opts ) ) {
+                       $self->{__option}->{ lc( $k ) } = $v || '';
+               }
+       }
+       $self->_parse_options;
+
+       my @file = @_;
+       foreach my $f (@file) {
+               $self->_rewrite_file( $f );
+       }
+
+       return;
+}
+
+sub _parse_options
+{
+       my $self = shift;
+       my $cwd = Cwd::getcwd();
+       foreach my $t ( qw(from to) ) {
+        $self->{__option}->{$t} = $cwd unless $self->{__option}->{$t};
+               my $d = $self->{__option}->{$t};
+               die "Couldn't read directory '$d'" unless -d $d && -r _;
+       }
+}
+
+sub _rewrite_file
+{
+       my ($self, $file) = @_;
+       my $source = File::Spec->catfile( $self->{__option}{from}, $file );
+       $source .= $self->{__option}{sufix} if $self->{__option}{sufix};
+       unless( -f $source && -r _ ) {
+               print STDERR "Couldn't find file '$source'\n";
+               return;
+       }
+       my $dest = File::Spec->catfile( $self->{__option}{to}, $file );
+       return $self->__rewrite_file( $source, $dest );
+}
+
+sub __rewrite_file
+{
+       my ($self, $source, $dest) = @_;
+
+       my $mode = (stat($source))[2];
+
+       open my $sfh, "<$source" or die "Couldn't open '$source' for read";
+       print "Open input '$source' file for substitution\n";
+
+       my ($tmpfh, $tmpfname) = File::Temp::tempfile('mi-subst-XXXX', UNLINK => 1);
+       $self->__process_streams( $sfh, $tmpfh, ($source eq $dest)? 1: 0 );
+       close $sfh;
+
+       seek $tmpfh, 0, 0 or die "Couldn't seek in tmp file";
+
+       open my $dfh, ">$dest" or die "Couldn't open '$dest' for write";
+       print "Open output '$dest' file for substitution\n";
+
+       while( <$tmpfh> ) {
+               print $dfh $_;
+       }
+       close $dfh;
+       chmod $mode, $dest or "Couldn't change mode on '$dest'";
+}
+
+sub __process_streams
+{
+       my ($self, $in, $out, $replace) = @_;
+       
+       my @queue = ();
+       my $subst = $self->{'__subst'};
+       my $re_subst = join('|', map {"\Q$_"} keys %{ $subst } );
+
+       while( my $str = <$in> ) {
+               if( $str =~ /^###\s*(before|replace|after)\:\s?(.*)$/s ) {
+                       my ($action, $nstr) = ($1,$2);
+                       $nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge;
+
+                       die "Replace action is bad idea for situations when dest is equal to source"
+                if $replace && $action eq 'replace';
+                       if( $action eq 'before' ) {
+                               die "no line before 'before' action" unless @queue;
+                               # overwrite prev line;
+                               pop @queue;
+                               push @queue, $nstr;
+                               push @queue, $str;
+                       } elsif( $action eq 'replace' ) {
+                               push @queue, $nstr;
+                       } elsif( $action eq 'after' ) {
+                               push @queue, $str;
+                               push @queue, $nstr;
+                               # skip one line;
+                               <$in>;
+                       }
+               } else {
+                       push @queue, $str;
+               }
+               while( @queue > 3 ) {
+                       print $out shift(@queue);
+               }
+       }
+       while( scalar @queue ) {
+               print $out shift(@queue);
+       }
+}
+
+1;
+
index edc18b4..eeaa3fe 100644 (file)
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '1.00';
+       $VERSION = '1.06';
        @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
 }
        @ISA     = 'Module::Install::Base';
        $ISCORE  = 1;
 }
index d0f6599..85d8018 100644 (file)
@@ -6,7 +6,7 @@ use Module::Install::Base ();
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
 
 use vars qw{$VERSION @ISA $ISCORE};
 BEGIN {
-       $VERSION = '1.00';
+       $VERSION = '1.06';
        @ISA     = qw{Module::Install::Base};
        $ISCORE  = 1;
 }
        @ISA     = qw{Module::Install::Base};
        $ISCORE  = 1;
 }