[Rt-commit] rtir branch, 2.9-trunk, updated. 42372f1804562ac39df7eb378c07df863104bf0d
Ruslan Zakirov
ruz at bestpractical.com
Wed Nov 3 22:46:18 EDT 2010
The branch, 2.9-trunk has been updated
via 42372f1804562ac39df7eb378c07df863104bf0d (commit)
via 3a31adb3a7b29af9a148c7d36527834be93017ec (commit)
via 8867eb3cbd8c40c8616cb2ddaa43f96c843fe5d6 (commit)
via da9f00f0a536f8812cd7bd5cb8eb7a61a5dbee49 (commit)
via f79b1cb14cda96fb63a849d07bb55d4084418ade (commit)
via 5cf914f84b1255e0b55429d96a1ce8c2ad2c3227 (commit)
via 68585e15283cea43d9fcc2759bcaed2ad98ce947 (commit)
via 333f38044cf87b9ed5d14809d873e0fe4de61b7b (commit)
via ba230ed9b9a280849bb6c4fa0b613d044d9773ba (commit)
via 37d8eee2ee6e56a9226d73c1de49cc8cb72ab1e7 (commit)
via 2fe54d9421c82db8ff3de3d7493dac1cd26800b7 (commit)
via a9b74ad2f89d00c354435eab2c04b0be0c09ccc8 (commit)
via f9ece01e92973437e701dad954aac0e89df29ae9 (commit)
via cdbbe48dfad106bf6812608c609a02fd3dfcde6c (commit)
via aa262efbc28ab8a479431191c3f1c462d19d6265 (commit)
from 8bea22223848861aa0e08c2c268ab23083efa964 (commit)
Summary of changes:
MANIFEST | 6 +-
MANIFEST.SKIP | 1 +
META.yml | 8 +-
Makefile.PL | 4 +-
README | 159 ----------------------
etc/RTIR_Config.pm | 112 ++++++++++++++++
html/RTIR/Elements/QueueTabs | 114 ++++++-----------
inc/Module/AutoInstall.pm | 19 +++-
inc/Module/Install.pm | 218 ++++++++++++++++++------------
inc/Module/Install/AutoInstall.pm | 25 +++-
inc/Module/Install/Base.pm | 11 +-
inc/Module/Install/Can.pm | 2 +-
inc/Module/Install/Fetch.pm | 2 +-
inc/Module/Install/Include.pm | 2 +-
inc/Module/Install/Makefile.pm | 229 ++++++++++++++++++++++++++------
inc/Module/Install/Metadata.pm | 267 +++++++++++++++++++++++++------------
inc/Module/Install/RTx.pm | 18 +--
inc/Module/Install/RTx/Factory.pm | 2 +-
inc/Module/Install/Win32.pm | 2 +-
inc/Module/Install/WriteAll.pm | 7 +-
lib/RT/IR/Test.pm | 4 +
t/002-test-reject.t | 4 +-
t/005-resolve-investigations.t | 2 +-
t/008-workflow-blocks.t | 16 +--
24 files changed, 728 insertions(+), 506 deletions(-)
- Log -----------------------------------------------------------------
commit aa262efbc28ab8a479431191c3f1c462d19d6265
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Wed Nov 3 02:31:01 2010 +0300
manifest update
diff --git a/MANIFEST b/MANIFEST
index d01080c..0e8ca4e 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -31,8 +31,10 @@ etc/upgrade/2.3.0/content
etc/upgrade/2.3.9/content
etc/upgrade/2.5.1/content
etc/upgrade/2.5.1/update_saved_searches.pl
+etc/upgrade/2.9.0/content
etc/upgrade/upgrade.pl
html/Callbacks/RTIR/autohandler/Default
+html/Callbacks/RTIR/Elements/ColumnMap/Once
html/Callbacks/RTIR/Elements/EditCustomField/EditComponentName
html/Callbacks/RTIR/Elements/Header/Default
html/Callbacks/RTIR/Elements/Header/Head
@@ -52,7 +54,6 @@ html/Callbacks/RTIR/Ticket/Elements/EditCustomFields/MassageCustomFields
html/Callbacks/RTIR/Ticket/Elements/ShowHistory/SkipTransaction
html/Callbacks/RTIR/User/Elements/Tabs/Default
html/RTIR/Advanced.html
-html/RTIR/Block/Elements/EditState
html/RTIR/Block/Elements/Tabs
html/RTIR/Create.html
html/RTIR/Display.html
@@ -172,8 +173,6 @@ lib/RT/Action/RTIR_SetDueToNow.pm
lib/RT/Action/RTIR_SetHowReported.pm
lib/RT/Action/RTIR_SetIncidentReportState.pm
lib/RT/Action/RTIR_SetIncidentResolution.pm
-lib/RT/Action/RTIR_SetIncidentState.pm
-lib/RT/Action/RTIR_SetInvestigationState.pm
lib/RT/Action/RTIR_SetStartedToNow.pm
lib/RT/Action/RTIR_SetStartsByBizHours.pm
lib/RT/Action/RTIR_SetStartsToNow.pm
@@ -254,5 +253,4 @@ t/incident/abandon.t
t/incident/bulk-abandon.t
t/incident/split.t
t/mail/skip_notification.t
-TODO.switch_custom_fields_to_generic_RT_methods
UPGRADING
commit cdbbe48dfad106bf6812608c609a02fd3dfcde6c
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Wed Nov 3 03:27:56 2010 +0300
upgrade M::I
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
index dfb8ef7..60b90ea 100644
--- a/inc/Module/AutoInstall.pm
+++ b/inc/Module/AutoInstall.pm
@@ -253,6 +253,8 @@ sub import {
# import to main::
no strict 'refs';
*{'main::WriteMakefile'} = \&Write if caller(0) eq 'main';
+
+ return (@Existing, @Missing);
}
sub _running_under {
@@ -672,7 +674,20 @@ sub _load {
sub _load_cpan {
return if $CPAN::VERSION and $CPAN::Config and not @_;
require CPAN;
- if ( $CPAN::HandleConfig::VERSION ) {
+
+ # 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 {
@@ -802,4 +817,4 @@ END_MAKE
__END__
-#line 1056
+#line 1071
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/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
index 58dd026..f1f5356 100644
--- a/inc/Module/Install/AutoInstall.pm
+++ b/inc/Module/Install/AutoInstall.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.91';
+ $VERSION = '1.00';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -37,12 +37,33 @@ sub auto_install {
$self->include('Module::AutoInstall');
require Module::AutoInstall;
- Module::AutoInstall->import(
+ 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);
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/Include.pm b/inc/Module/Install/Include.pm
index 7e792e0..a28cd4c 100644
--- a/inc/Module/Install/Include.pm
+++ b/inc/Module/Install/Include.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '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 a06cb6d..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";
}
}
@@ -144,7 +145,6 @@ dropdb ::
$has_etc{acl}++;
}
if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
- if ( -e 'etc/upgrade' ) { $has_etc{upgrade}++; }
$self->postamble("$postamble\n");
unless ( $subdirs{'lib'} ) {
@@ -173,14 +173,6 @@ dropdb ::
.
$self->postamble("initdb ::\n$initdb\n");
$self->postamble("initialize-database ::\n$initdb\n");
-
- if ( $has_etc{upgrade} ) {
- my $cmds = <<".";
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(upgrade))"
-.
- $self->postamble("upgrade ::\n$cmds\n");
- }
-
}
}
@@ -197,4 +189,4 @@ sub RTxInit {
__END__
-#line 311
+#line 303
diff --git a/inc/Module/Install/RTx/Factory.pm b/inc/Module/Install/RTx/Factory.pm
index cf9ad8e..23ce911 100644
--- a/inc/Module/Install/RTx/Factory.pm
+++ b/inc/Module/Install/RTx/Factory.pm
@@ -30,7 +30,7 @@ sub RTxInitDB {
"-I$lib_path",
"$RT::SbinPath/rt-setup-database",
"--action" => $action,
- "--datadir" => $action ne 'upgrade'? 'etc' : 'etc/upgrade',
+ "--datadir" => "etc",
(($action eq 'insert') ? ("--datafile" => "etc/initialdata") : ()),
"--dba" => $RT::DatabaseUser,
"--prompt-for-dba-password" => ''
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 f9ece01e92973437e701dad954aac0e89df29ae9
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Wed Nov 3 03:29:29 2010 +0300
update META
diff --git a/META.yml b/META.yml
index 5cf39f2..abed910 100644
--- a/META.yml
+++ b/META.yml
@@ -10,8 +10,8 @@ build_requires:
configure_requires:
ExtUtils::MakeMaker: 6.42
distribution_type: module
-generated_by: 'Module::Install version 0.91'
-license: 'GPL Version 2'
+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
@@ -28,9 +28,9 @@ requires:
Business::SLA: 0
DBIx::SearchBuilder: 1.51
Hook::LexWrap: 0
- Net::CIDR: 0
Net::Whois::RIPE: 0
Regexp::Common: 0
- Regexp::Common::net::CIDR: 0
perl: 5.8.3
+resources:
+ license: http://opensource.org/licenses/gpl-license.php
version: 2.5.7
commit a9b74ad2f89d00c354435eab2c04b0be0c09ccc8
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Wed Nov 3 03:29:45 2010 +0300
skip t/tmp from manifest
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
index 68df735..b0e4c8f 100644
--- a/MANIFEST.SKIP
+++ b/MANIFEST.SKIP
@@ -6,3 +6,4 @@
\.old$
\.bak$
^Makefile$
+^t/tmp
commit 2fe54d9421c82db8ff3de3d7493dac1cd26800b7
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Wed Nov 3 09:49:04 2010 +0300
there is not RT 3.9.6 at the moment, only 3.9.4
diff --git a/Makefile.PL b/Makefile.PL
index 964d74b..762281e 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -7,8 +7,8 @@ version_from('lib/RT/IR.pm');
{ # check RT version
my @v = split /\./, "$RT::VERSION";
- unless ($v[0]>=3 && $v[1]>=9 && ($v[2]>=6 || $v[2]eq'HEAD')) {
- die "RTIR 2.4.2 and newer needs RT 3.9.6 at least, you have $RT::VERSION";
+ unless ($v[0]>=3 && $v[1]>=9 && ($v[2]>=4 || $v[2]eq'HEAD')) {
+ die "RTIR 2.4.2 and newer needs RT 3.9.4 at least, you have $RT::VERSION";
}
}
commit 37d8eee2ee6e56a9226d73c1de49cc8cb72ab1e7
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Wed Nov 3 10:02:46 2010 +0300
don't copy default RT's lifecycle
diff --git a/README b/README
index b0694ee..9e7c66f 100644
--- a/README
+++ b/README
@@ -54,46 +54,7 @@ Installation instructions:
Set(
%Lifecycles,
default => {
- default_initial => 'new',
- initial => [ 'new', 'open' ],
- active => [ 'open', 'stalled' ],
- inactive => [ 'resolved', 'rejected', 'deleted' ],
- default_inactive => 'resolved',
-
- transitions => {
-
- # from => [ to list ],
- new => [qw(open stalled resolved rejected deleted)],
- open => [qw(new stalled resolved rejected deleted)],
- stalled => [qw(new open rejected resolved deleted)],
- resolved => [qw(new open stalled rejected deleted)],
- rejected => [qw(new open stalled resolved deleted)],
- deleted => [qw(new open stalled rejected resolved)],
- },
- rights => {
- '* -> deleted' => 'DeleteTicket',
- '* -> rejected' => 'ModifyTicket',
- '* -> *' => 'ModifyTicket',
- },
- actions => {
-
- # 'from -> to' => [action text, Respond/Comment/hide/''],
- 'new -> open' => [ 'Open It', 'Respond' ],
- 'new -> resolved' => [ 'Resolve', 'Comment' ],
- 'new -> rejected' => [ 'Reject', 'Respond' ],
- 'new -> deleted' => [ 'Delete', '' ],
-
- 'open -> stalled' => [ 'Stall', 'Comment' ],
- 'open -> resolved' => [ 'Resolve', 'Comment' ],
- 'open -> rejected' => [ 'Reject', 'Respond' ],
- 'open -> deleted' => [ 'Delete', 'hide' ],
-
- 'stalled -> open' => [ 'Open It', '' ],
- 'resolved -> open' => [ 'Re-open', 'Comment' ],
- 'rejected -> open' => [ 'Re-open', 'Comment' ],
- 'deleted -> open' => [ 'Undelete', '' ],
- 'open -> new' => [ 'New', 'hide' ],
- },
+ ... whatever you use in RT ...
},
incidents => {
default_initial => 'open',
commit ba230ed9b9a280849bb6c4fa0b613d044d9773ba
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Wed Nov 3 10:04:35 2010 +0300
delete several transitions that are not useful
diff --git a/README b/README
index 9e7c66f..72f1001 100644
--- a/README
+++ b/README
@@ -64,11 +64,10 @@ Installation instructions:
default_inactive => 'resolved',
transitions => {
-
# from => [ to list ],
open => [qw(resolved abandoned)],
- resolved => [qw(open abandoned)],
- abandoned => [qw(open resolved)],
+ resolved => [qw(open)],
+ abandoned => [qw(open)],
},
rights => { '* -> *' => 'ModifyTicket', },
actions => {
@@ -83,15 +82,15 @@ Installation instructions:
initial => [ 'new', 'open' ],
active => ['open'],
inactive => [ 'resolved', 'rejected' ],
- default_inactive => 'resolved',
+ default_inactive => 'resolved',
transitions => {
# from => [ to list ],
new => [qw(open resolved rejected)],
open => [qw(resolved rejected)],
- resolved => [qw(new open rejected)],
- rejected => [qw(new open resolved)],
+ resolved => [qw(open)],
+ rejected => [qw(open)],
},
rights => { '* -> *' => 'ModifyTicket', },
actions => {
@@ -133,14 +132,10 @@ Installation instructions:
default_inactive => 'removed',
transitions => {
- 'pending activation' =>
- [ 'active', 'pending removal', 'removed' ],
- active =>
- [ 'pending removal', 'removed' ],
- 'pending removal' =>
- [ 'removed', 'active' ],
- removed =>
- [ 'active', 'pending removal' ],
+ 'pending activation' => [ 'active', 'removed' ],
+ active => [ 'pending removal', 'removed' ],
+ 'pending removal' => [ 'removed', 'active' ],
+ removed => [ 'active' ],
},
rights => { '* -> *' => 'ModifyTicket', },
actions => {
commit 333f38044cf87b9ed5d14809d873e0fe4de61b7b
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Wed Nov 3 10:05:44 2010 +0300
use new way to describe actions
needs 3.9-lifecycles_improvments branch at the moment
diff --git a/README b/README
index 72f1001..4c34a5f 100644
--- a/README
+++ b/README
@@ -71,10 +71,18 @@ Installation instructions:
},
rights => { '* -> *' => 'ModifyTicket', },
actions => {
- 'open -> resolved' => [ 'Resolve', 'Comment' ],
- 'open -> abandoned' => [ 'Abandon', 'Comment' ],
- 'resolved -> open' => [ 'Re-open', 'Comment' ],
- 'abandoned -> open' => [ 'Re-open', 'Comment' ],
+ 'open -> resolved' => {
+ label => 'Resolve', update => 'Comment',
+ All => 1, SelectAllTickets => 1,
+ },
+ 'open -> abandoned' => {
+ label => 'Abandon', update => 'Comment',
+ All => 1, SelectAllTickets => 1,
+ },
+ '* -> open' => {
+ label => 'Re-open', update => 'Comment',
+ All => 1, SelectAllTickets => 1,
+ },
},
},
incident_reports => {
@@ -94,15 +102,14 @@ Installation instructions:
},
rights => { '* -> *' => 'ModifyTicket', },
actions => {
- 'new -> open' => [ 'Open It', 'Respond' ],
- 'new -> resolved' => [ 'Resolve', 'Comment' ],
- 'new -> rejected' => [ 'Reject', 'Respond' ],
-
- 'open -> resolved' => [ 'Resolve', 'Comment' ],
- 'open -> rejected' => [ 'Reject', 'Respond' ],
-
- 'resolved -> open' => [ 'Re-open', 'Comment' ],
- 'rejected -> open' => [ 'Re-open', 'Comment' ],
+ 'new -> open' => { label => 'Open It', update => 'Respond' },
+ '* -> resolved' => { label => 'Resolve', update => 'Comment' },
+ '* -> resolved' => { label => 'Quick Resolve' },
+ '* -> rejected' =>
+ { label => 'Reject', update => 'Respond', TakeOrStealFirst => 1 },
+ '* -> rejected' => { label => 'Quick Reject', TakeOrStealFirst => 1 },
+ 'resolved -> open' => { label => 'Re-open', update => 'Comment' },
+ 'rejected -> open' => { label => 'Re-open', update => 'Comment' },
},
},
investigations => {
@@ -120,8 +127,8 @@ Installation instructions:
},
rights => { '* -> *' => 'ModifyTicket', },
actions => {
- 'open -> resolved' => [ 'Resolve', 'Comment' ],
- 'resolved -> open' => [ 'Re-open', 'Comment' ],
+ 'open -> resolved' => { label => 'Resolve', update => 'Comment' },
+ 'resolved -> open' => { label => 'Re-open', update => 'Comment' },
},
},
blocks => {
@@ -139,21 +146,11 @@ Installation instructions:
},
rights => { '* -> *' => 'ModifyTicket', },
actions => {
- 'pending activation -> active' => [ 'Activate', 'Comment' ],
- 'pending activation -> pending removal' =>
- [ 'Pending to remove', 'Comment' ],
- 'pending activation -> removed' => [ 'Remove', 'Comment' ],
-
- 'active -> pending removal' =>
- [ 'Pending to remove', 'Comment' ],
- 'active -> removed' => [ 'Remove', 'Comment' ],
-
- 'pending removal -> removed' => [ 'Remove', 'Comment' ],
- 'pending removal -> active' => [ 'Activate', 'Comment' ],
-
- 'removed -> active' => [ 'Activate', 'Comment' ],
- 'removed -> pending removal' =>
- [ 'Pending to remove', 'Comment' ],
+ '* -> active' => { label => 'Activate', update => 'Comment' },
+ '* -> removed' => { label => 'Remove', update => 'Comment' },
+ '* -> removed' => { label => 'Quick Remove' },
+ '* -> pending removal' =>
+ { label => 'Pending Removal', update => 'Comment' },
},
},
);
commit 68585e15283cea43d9fcc2759bcaed2ad98ce947
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Nov 4 05:41:02 2010 +0300
drop lifecycles for RTIR from README
diff --git a/README b/README
index 4c34a5f..e1efc7e 100644
--- a/README
+++ b/README
@@ -51,118 +51,6 @@ Installation instructions:
7) Activate RTIR extension in the RT config:
Set(@Plugins, 'RT::FM', 'RT::IR');
- Set(
- %Lifecycles,
- default => {
- ... whatever you use in RT ...
- },
- incidents => {
- default_initial => 'open',
- initial => ['open'],
- active => ['open'],
- inactive => [ 'resolved', 'abandoned' ],
- default_inactive => 'resolved',
-
- transitions => {
- # from => [ to list ],
- open => [qw(resolved abandoned)],
- resolved => [qw(open)],
- abandoned => [qw(open)],
- },
- rights => { '* -> *' => 'ModifyTicket', },
- actions => {
- 'open -> resolved' => {
- label => 'Resolve', update => 'Comment',
- All => 1, SelectAllTickets => 1,
- },
- 'open -> abandoned' => {
- label => 'Abandon', update => 'Comment',
- All => 1, SelectAllTickets => 1,
- },
- '* -> open' => {
- label => 'Re-open', update => 'Comment',
- All => 1, SelectAllTickets => 1,
- },
- },
- },
- incident_reports => {
- default_initial => 'new',
- initial => [ 'new', 'open' ],
- active => ['open'],
- inactive => [ 'resolved', 'rejected' ],
- default_inactive => 'resolved',
-
- transitions => {
-
- # from => [ to list ],
- new => [qw(open resolved rejected)],
- open => [qw(resolved rejected)],
- resolved => [qw(open)],
- rejected => [qw(open)],
- },
- rights => { '* -> *' => 'ModifyTicket', },
- actions => {
- 'new -> open' => { label => 'Open It', update => 'Respond' },
- '* -> resolved' => { label => 'Resolve', update => 'Comment' },
- '* -> resolved' => { label => 'Quick Resolve' },
- '* -> rejected' =>
- { label => 'Reject', update => 'Respond', TakeOrStealFirst => 1 },
- '* -> rejected' => { label => 'Quick Reject', TakeOrStealFirst => 1 },
- 'resolved -> open' => { label => 'Re-open', update => 'Comment' },
- 'rejected -> open' => { label => 'Re-open', update => 'Comment' },
- },
- },
- investigations => {
- default_initial => 'open',
- initial => ['open'],
- active => ['open'],
- inactive => ['resolved'],
- default_inactive => 'resolved',
-
- transitions => {
-
- # from => [ to list ],
- open => [qw(resolved)],
- resolved => [qw(open)],
- },
- rights => { '* -> *' => 'ModifyTicket', },
- actions => {
- 'open -> resolved' => { label => 'Resolve', update => 'Comment' },
- 'resolved -> open' => { label => 'Re-open', update => 'Comment' },
- },
- },
- blocks => {
- default_initial => 'pending activation',
- initial => ['pending activation'],
- active => [ 'active', 'pending removal' ],
- inactive => ['removed'],
- default_inactive => 'removed',
-
- transitions => {
- 'pending activation' => [ 'active', 'removed' ],
- active => [ 'pending removal', 'removed' ],
- 'pending removal' => [ 'removed', 'active' ],
- removed => [ 'active' ],
- },
- rights => { '* -> *' => 'ModifyTicket', },
- actions => {
- '* -> active' => { label => 'Activate', update => 'Comment' },
- '* -> removed' => { label => 'Remove', update => 'Comment' },
- '* -> removed' => { label => 'Quick Remove' },
- '* -> pending removal' =>
- { label => 'Pending Removal', update => 'Comment' },
- },
- },
- );
-
- Set(
- %LifecycleMap,
- General => 'default',
- Incidents => 'incidents',
- 'Incident Reports' => 'incident_reports',
- Investigations => 'investigations',
- Blocks => 'blocks',
- );
8) Stop and start your web server.
commit 5cf914f84b1255e0b55429d96a1ce8c2ad2c3227
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Nov 4 05:41:42 2010 +0300
lifecycles goes into RTIR config
diff --git a/etc/RTIR_Config.pm b/etc/RTIR_Config.pm
index a1bbaad..cebd00e 100644
--- a/etc/RTIR_Config.pm
+++ b/etc/RTIR_Config.pm
@@ -277,4 +277,116 @@ Set($RTIR_BlockAproveActionRegexp, undef);
# other actions don't apply to the same matched text
Set(@Active_MakeClicky, qw(httpurl_overwrite ip email domain));
+Set(
+ %Lifecycles,
+ incidents => {
+ default_initial => 'open',
+ initial => ['open'],
+ active => ['open'],
+ inactive => [ 'resolved', 'abandoned' ],
+ default_inactive => 'resolved',
+
+ transitions => {
+ # from => [ to list ],
+ open => [qw(resolved abandoned)],
+ resolved => [qw(open)],
+ abandoned => [qw(open)],
+ },
+ rights => { '* -> *' => 'ModifyTicket', },
+ actions => [
+ 'open -> resolved' => {
+ label => 'Resolve', update => 'Comment',
+ All => 1, SelectAllTickets => 1,
+ },
+ 'open -> resolved' => {
+ label => 'Quick Resolve',
+ },
+ 'open -> abandoned' => {
+ label => 'Abandon', update => 'Comment',
+ All => 1, SelectAllTickets => 1,
+ },
+ '* -> open' => {
+ label => 'Re-open',
+ All => 1, SelectAllTickets => 1,
+ },
+ ],
+ },
+ incident_reports => {
+ default_initial => 'new',
+ initial => [ 'new', 'open' ],
+ active => ['open'],
+ inactive => [ 'resolved', 'rejected' ],
+ default_inactive => 'resolved',
+
+ transitions => {
+
+ # from => [ to list ],
+ new => [qw(open resolved rejected)],
+ open => [qw(resolved rejected)],
+ resolved => [qw(open)],
+ rejected => [qw(open)],
+ },
+ rights => { '* -> *' => 'ModifyTicket', },
+ actions => [
+ 'new -> open' => { label => 'Open It', update => 'Respond' },
+ '* -> resolved' => { label => 'Resolve', update => 'Comment' },
+ '* -> resolved' => { label => 'Quick Resolve' },
+ '* -> rejected' =>
+ { label => 'Reject', update => 'Respond', TakeOrStealFirst => 1 },
+ '* -> rejected' => { label => 'Quick Reject', TakeOrStealFirst => 1 },
+ '* -> open' => { label => 'Re-open' },
+ ],
+ },
+ investigations => {
+ default_initial => 'open',
+ initial => ['open'],
+ active => ['open'],
+ inactive => ['resolved'],
+ default_inactive => 'resolved',
+
+ transitions => {
+
+ # from => [ to list ],
+ open => [qw(resolved)],
+ resolved => [qw(open)],
+ },
+ rights => { '* -> *' => 'ModifyTicket', },
+ actions => [
+ '* -> resolved' => { label => 'Resolve', update => 'Comment' },
+ '* -> resolved' => { label => 'Quick Resolve' },
+ 'resolved -> open' => { label => 'Re-open' },
+ ],
+ },
+ blocks => {
+ default_initial => 'pending activation',
+ initial => ['pending activation'],
+ active => [ 'active', 'pending removal' ],
+ inactive => ['removed'],
+ default_inactive => 'removed',
+
+ transitions => {
+ 'pending activation' => [ 'active', 'removed' ],
+ active => [ 'pending removal', 'removed' ],
+ 'pending removal' => [ 'removed', 'active' ],
+ removed => [ 'active' ],
+ },
+ rights => { '* -> *' => 'ModifyTicket', },
+ actions => [
+ '* -> active' => { label => 'Activate', update => 'Comment' },
+ '* -> removed' => { label => 'Remove', update => 'Comment' },
+ '* -> removed' => { label => 'Quick Remove' },
+ '* -> pending removal' =>
+ { label => 'Pending Removal', update => 'Comment' },
+ ],
+ },
+);
+
+Set(
+ %LifecycleMap,
+ Incidents => 'incidents',
+ 'Incident Reports' => 'incident_reports',
+ Investigations => 'investigations',
+ Blocks => 'blocks',
+);
+
1;
commit f79b1cb14cda96fb63a849d07bb55d4084418ade
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Nov 4 05:42:31 2010 +0300
generate tickets' actions using lifecycles
diff --git a/html/RTIR/Elements/QueueTabs b/html/RTIR/Elements/QueueTabs
index e752c05..7c1cbd9 100644
--- a/html/RTIR/Elements/QueueTabs
+++ b/html/RTIR/Elements/QueueTabs
@@ -177,70 +177,6 @@ if ( $Ticket && $Ticket->QueueObj->Name eq $QueueName ) {
}
}
- if ( $can{'ModifyTicket'} ) {
- if ( $Ticket->QueueObj->IsActiveStatus( $Ticket->Status ) ) {
- if ( $Type =~ /^(Report|Investigation)$/ ) {
- $actions->{'Ac'} = {
- path => "RTIR/Update.html?Action=Comment&DefaultStatus=resolved&id=$id",
- title => loc('Resolve'),
- };
- $actions->{'Acc'} = {
- path => "RTIR/Display.html?Status=resolved&id=$id",
- title => loc('Quick Resolve'),
- };
- } elsif ( $Type eq 'Incident' ) {
- $actions->{'Ac'} = {
- path => "RTIR/Incident/Reply.html?id=$id&Action=Comment&All=1&DefaultStatus=resolved&SelectAllTickets=1",
- title => loc('Resolve'),
- };
- $actions->{'Acc'} = {
- path => "RTIR/Display.html?Status=resolved&id=$id",
- title => loc('Quick Resolve'),
- };
- } elsif ( $Type eq 'Block' ) {
- if ( $Ticket->Status ne 'active' ) {
- $actions->{'Ab'} = {
- path => "RTIR/Update.html?Action=Comment&DefaultStatus=active&id=$id",
- title => loc('Activate')
- };
- }
- $actions->{'Ac'} = {
- path => "RTIR/Update.html?Action=Comment&DefaultStatus=removed&id=$id",
- title => loc('Remove'),
- };
- $actions->{'Acc'} = {
- path => "RTIR/Display.html?Status=removed&id=$id",
- title => loc('Quick Remove'),
- };
- }
- if ( $Type eq 'Incident' ) {
- $actions->{'B'} = {
- path =>
- "RTIR/Incident/Reply.html?id=$id&Action=Comment&All=1&DefaultStatus=abandoned&SelectAllTickets=1",
- title => loc('Abandon'),
- };
- }
- } else {
- if ( $Type eq 'Block' ) {
- $actions->{'C'} = {
- path => "RTIR/Update.html?Action=Comment&DefaultStatus=active&id=$id",
- title => loc('Activate')
- };
- } else {
- $actions->{'C'} = {
- path => "RTIR/Display.html?Status=open&id=$id",
- title => loc('Open')
- };
- }
- }
- if ( $Type eq 'Block' && $Ticket->Status eq 'active' ) {
- $actions->{'Ab'} = {
- path => "RTIR/Update.html?Action=Respond&DefaultStatus=pending removal&id=$id",
- title => loc('Pending Removal'),
- };
- }
- }
-
if ( $can{'OwnTicket'} ) {
if ( $Ticket->Owner == $RT::Nobody->id ) {
$actions->{'D'} = {
@@ -255,20 +191,46 @@ if ( $Ticket && $Ticket->QueueObj->Name eq $QueueName ) {
}
}
- if ( ( $can{'ModifyTicket'} || $can{'OwnTicket'} )
- && $Ticket->QueueObj->IsActiveStatus( $Ticket->Status ) )
- {
- if ( $Type eq 'Report' ) {
- $actions->{'B'} = {
- path => "RTIR/Update.html?Action=Comment&TakeOrStealFirst=1&DefaultStatus=rejected&id=$id",
- title => loc('Reject'),
- };
+ my $i = 0;
+ my $status = $Ticket->Status;
+ my $lifecycle = $Ticket->QueueObj->lifecycle;
+ foreach my $info ( $lifecycle->actions( $status ) ) {
+ my $next = $info->{'to'};
+ next unless $lifecycle->is_transition( $status => $next );
+
+ my %args = (%$info, id => $id);
+ delete @args{qw(to from label update)};
+
+ # if user will be owner then he will get more rights
+ # TODO: check actually if he will get required rights
+ if ( !$args{'TakeOrStealFirst'} || $session{'CurrentUser'}->id == $Ticket->Owner ) {
+ my $check = $lifecycle->check_right( $status => $next );
+ $can{$check} = $Ticket->CurrentUserHasRight($check)
+ unless exists $can{$check};
+ next unless $can{$check};
+ }
- $actions->{'Bb'} = {
- path => "RTIR/Display.html?Status=rejected&TakeOrStealFirst=1&id=$id",
- title => loc('Quick Reject'),
- };
+ my $path = 'RTIR/';
+ $path .= 'Incident/' if $Type eq 'Incident';
+ if ( my $update = $info->{'update'} ) {
+ $path .= $Type eq 'Incident'? 'Reply.html' : 'Update.html';
+ $path .= "?". $m->comp(
+ '/Elements/QueryString',
+ %args,
+ Action => $update,
+ DefaultStatus => $next,
+ );
+ } else {
+ $path .= "Display.html?". $m->comp(
+ '/Elements/QueryString',
+ %args,
+ Status => $next,
+ );
}
+ $actions->{ 'Ab'. $i++ } = {
+ path => $path,
+ title => loc( $info->{'label'} || ucfirst($next) ),
+ };
}
if ( $can{'ModifyTicket'} || $can{'CommentOnTicket'} ) {
commit da9f00f0a536f8812cd7bd5cb8eb7a61a5dbee49
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Nov 4 05:43:00 2010 +0300
refil lifecycles cache during testing
diff --git a/lib/RT/IR/Test.pm b/lib/RT/IR/Test.pm
index 3a93ef8..3f50e98 100644
--- a/lib/RT/IR/Test.pm
+++ b/lib/RT/IR/Test.pm
@@ -43,6 +43,10 @@ sub import {
RT->Config->LoadConfig( File => 'RTIR_Config.pm' );
RT->Config->Set( 'rtirname' => 'regression_tests' );
+
+ require RT::Lifecycle;
+ RT::Lifecycle->fill_cache;
+
require RT::IR;
}
commit 8867eb3cbd8c40c8616cb2ddaa43f96c843fe5d6
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Nov 4 05:43:35 2010 +0300
pending activation -> pending removal is not valid transition
there is no point to pend for removal if a block is not active
diff --git a/t/008-workflow-blocks.t b/t/008-workflow-blocks.t
index 7012a84..9b989a2 100644
--- a/t/008-workflow-blocks.t
+++ b/t/008-workflow-blocks.t
@@ -3,7 +3,7 @@
use strict;
use warnings;
-use RT::IR::Test tests => 115;
+use RT::IR::Test tests => 118;
RT::Test->started_ok;
my $agent = default_agent();
@@ -27,22 +27,12 @@ $agent->ticket_status_is( $block_id, 'pending activation');
$agent->has_tag('a', 'Remove', 'we have Remove action');
$agent->has_tag('a', 'Quick Remove', 'we have Quick Remove action');
-#my %state = (
-# new => 'pending activation',
-# open => 'active',
-# stalled => 'pending removal',
-# resolved => 'removed',
-# rejected => 'removed',
-#);
-#
-#foreach my $status( qw(open stalled resolved) ) {
-foreach my $status( 'pending activation', 'pending removal', 'removed' ) {
+foreach my $status( 'pending activation', 'active', 'pending removal', 'removed' ) {
$agent->follow_link_ok({ text => "Edit" }, "Goto edit page");
$agent->form_number(3);
$agent->field(Status => $status);
$agent->click('SaveChanges');
- my $state = $status;
- $agent->ticket_status_is( $block_id, $state);
+ $agent->ticket_status_is( $block_id, $status);
}
diag "remove using edit";
commit 3a31adb3a7b29af9a148c7d36527834be93017ec
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Nov 4 05:44:41 2010 +0300
inactive -> open is now labeled 'Re-open'
diff --git a/t/005-resolve-investigations.t b/t/005-resolve-investigations.t
index 7a85725..1268072 100644
--- a/t/005-resolve-investigations.t
+++ b/t/005-resolve-investigations.t
@@ -29,5 +29,5 @@ is ($agent->status, 200, "attempt to resolve inv succeeded");
like($agent->content, qr/Status changed from \S*open\S* to \S*resolved\S*/, "site says ticket got resolved");
-$agent->follow_link_ok({text => "Open"}, "Followed 'open' link");
+$agent->follow_link_ok({text => "Re-open"}, "Followed 'open' link");
like($agent->content, qr/Status changed from \S*resolved\S* to \S*open\S*/, "site says ticket got re-opened");
commit 42372f1804562ac39df7eb378c07df863104bf0d
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Nov 4 05:45:40 2010 +0300
ticket gets opened, adjust a test
diff --git a/t/002-test-reject.t b/t/002-test-reject.t
index 519d0df..bf6a066 100644
--- a/t/002-test-reject.t
+++ b/t/002-test-reject.t
@@ -39,7 +39,7 @@ for my $id ($nobody_quick, $me_quick) {
$agent->display_ticket( $id);
$agent->follow_link_ok({text => "Quick Reject"}, "Followed 'Quick Reject' link");
- like($agent->content, qr/Status changed from \S*new\S* to \S*rejected\S*/, "site says ticket got rejected");
+ like($agent->content, qr/Status changed from \S*(?:new|open)\S* to \S*rejected\S*/, "site says ticket got rejected");
}
for my $id ($nobody_slow, $me_slow) {
$agent->display_ticket( $id);
@@ -52,7 +52,7 @@ for my $id ($nobody_slow, $me_slow) {
is ($agent->status, 200, "attempt to reject succeeded");
- like($agent->content, qr/Status changed from \S*new\S* to \S*rejected\S*/, "site says ticket got rejected");
+ like($agent->content, qr/Status changed from \S*(?:new|open)\S* to \S*rejected\S*/, "site says ticket got rejected");
}
# we need to flush the cache, or else later the status change will not be detected
-----------------------------------------------------------------------
More information about the Rt-commit
mailing list