[Bps-public-commit] RT-Extension-CommandByMail branch, master, updated. 0.10-18-gc4d5de4
Ruslan Zakirov
ruz at bestpractical.com
Thu Feb 7 07:11:59 EST 2013
The branch, master has been updated
via c4d5de4440e5456bc23ff3fd800a4e4703fe8fcd (commit)
via 15247e139287049153a6b0c598b8950186b175b5 (commit)
via 49add88ab69a0ed3ec4c091f5b8832eb400aa1d0 (commit)
via 9ca419e0c82c4b79e4727e4b323f8f7af98c3e1c (commit)
via 06bee1c36d6e3787c608e9ab77cb6a5ac99b4a10 (commit)
via 337a8c8983a87ce904dbacba474d6e383cab09d8 (commit)
via 33d023989f6a96c3280679cbce3e83be29c54252 (commit)
via bf7a3688ecdc1dca3dcf27c81f26c73e0c140a7e (commit)
via b88f6d79f091fbb44dcbe0893b8dae893649f67d (commit)
via 937bf2ab30a4540ba0f8cefe0077862180c24abb (commit)
via bb3fee14b3090e7d1578f07adc71b79c9ffd92aa (commit)
via f32a75f5c936ec92df8e350725e3235a42365030 (commit)
via 6b2516b72f34fb6dc756585af46b3d6b3aee4c64 (commit)
via 6e6a27f5a31f0af151d439273b015684136ad100 (commit)
via e99f26b5cb6bf57562693fb483674eae306ab9e9 (commit)
from 81ade309a4494613823801e37b26addb4bb6f2ad (commit)
Summary of changes:
.gitignore | 2 +
Changes | 8 ++
MANIFEST | 14 +--
META.yml | 12 ++-
Makefile.PL | 4 +-
inc/Module/AutoInstall.pm | 150 ++++++++++++++++++++++++----
inc/Module/Install.pm | 6 +-
inc/Module/Install/AuthorTests.pm | 59 -----------
inc/Module/Install/AutoInstall.pm | 13 ++-
inc/Module/Install/Base.pm | 2 +-
inc/Module/Install/Can.pm | 85 ++++++++++++++--
inc/Module/Install/Fetch.pm | 2 +-
inc/Module/Install/Include.pm | 2 +-
inc/Module/Install/Makefile.pm | 27 ++---
inc/Module/Install/Metadata.pm | 22 ++--
inc/Module/Install/RTx.pm | 30 +-----
inc/Module/Install/Win32.pm | 2 +-
inc/Module/Install/WriteAll.pm | 2 +-
lib/RT/Extension/CommandByMail.pm | 3 +-
lib/RT/Extension/CommandByMail/Test.pm | 28 ++++++
lib/RT/Interface/Email/Filter/TakeAction.pm | 77 +++++++++++---
xt/02.create.t => t/create.t | 41 ++++----
xt/01.internals.t => t/internals.t | 10 +-
t/txn-cfs.t | 71 +++++++++++++
xt/03.update.t => t/update.t | 38 ++++---
xt/00.load.t | 30 ------
xt/04.send.t | 54 ----------
xt/pod-coverage.t | 6 --
xt/pod.t | 6 --
xt/utils.pl | 58 -----------
30 files changed, 488 insertions(+), 376 deletions(-)
delete mode 100644 inc/Module/Install/AuthorTests.pm
create mode 100644 lib/RT/Extension/CommandByMail/Test.pm
rename xt/02.create.t => t/create.t (89%)
rename xt/01.internals.t => t/internals.t (98%)
create mode 100644 t/txn-cfs.t
rename xt/03.update.t => t/update.t (88%)
delete mode 100644 xt/00.load.t
delete mode 100644 xt/04.send.t
delete mode 100644 xt/pod-coverage.t
delete mode 100644 xt/pod.t
delete mode 100644 xt/utils.pl
- Log -----------------------------------------------------------------
commit e99f26b5cb6bf57562693fb483674eae306ab9e9
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 00:46:31 2013 +0400
Test.pm for tests
diff --git a/lib/RT/Extension/CommandByMail/Test.pm b/lib/RT/Extension/CommandByMail/Test.pm
new file mode 100644
index 0000000..8255b39
--- /dev/null
+++ b/lib/RT/Extension/CommandByMail/Test.pm
@@ -0,0 +1,28 @@
+use strict;
+use warnings;
+
+### after: use lib qw(@RT_LIB_PATH@);
+use lib qw(/opt/rt4/local/lib /opt/rt4/lib);
+
+package RT::Extension::CommandByMail::Test;
+require RT::Test;
+our @ISA = 'RT::Test';
+
+sub import {
+ my $class = shift;
+ my %args = @_;
+
+ $args{'requires'} ||= [];
+ if ( $args{'testing'} ) {
+ unshift @{ $args{'requires'} }, 'RT::Extension::CommandByMail';
+ } else {
+ $args{'testing'} = 'RT::Extension::CommandByMail';
+ }
+
+ $class->SUPER::import( %args );
+ $class->export_to_level(1);
+
+ require RT::Extension::CommandByMail;
+}
+
+1;
commit 6e6a27f5a31f0af151d439273b015684136ad100
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 00:48:50 2013 +0400
put LIB paths into Test.pm with M::I::Substitute
diff --git a/Makefile.PL b/Makefile.PL
index 24b59d1..5a4aef0 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -25,7 +25,7 @@ substitute(
RT_BIN_PATH => $bin_path,
RT_SBIN_PATH => $sbin_path,
},
- qw(xt/utils.pl),
+ qw(xt/utils.pl lib/RT/Extension/CommandByMail/Test.pm),
);
author_tests('xt');
commit 6b2516b72f34fb6dc756585af46b3d6b3aee4c64
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 02:21:59 2013 +0400
this doesn't test anything in the extension
diff --git a/xt/04.send.t b/xt/04.send.t
deleted file mode 100644
index e410d2c..0000000
--- a/xt/04.send.t
+++ /dev/null
@@ -1,54 +0,0 @@
-#!/usr/bin/env perl
-
-use strict;
-use warnings;
-
-use Test::More tests => 1;
-
-use File::Temp qw/ tempfile tempdir /;
-
-BEGIN { require 'xt/utils.pl' }
-RT::Init;
-
-diag("test errors via mailgate") if $ENV{'TEST_VERBOSE'};
-{
- my $message_id = "foobar-$$\@example.com";
- my $text = <<END;
-Subject: error test
-From: root\@localhost
-Message-Id: $message_id
-
-Owner: this-user-does-not-exist\@example.com
-
-test
-END
-
- my ($fh, $filename) = tempfile();
- diag("Tempfile: $filename");
- if (RT->can('Config') && RT->Config->can('Set')) {
- RT->Config->Set(MailCommand => 'sendmailpipe');
- RT->Config->Set(SendmailPath => "cat > $filename;");
- RT->Config->Set(SendmailBounceArguments => '');
- RT->Config->Set(SendmailArguments => '');
- } else {
- $RT::MailCommand = 'sendmailpipe';
- $RT::SendmailPath = "cat > $filename;";
- $RT::SendmailBounceArguments = '';
- $RT::SendmailArguments = '';
- }
-
- use RT::EmailParser;
- my $parser = RT::EmailParser->new();
- $parser->ParseMIMEEntityFromScalar($text);
-
- RT::Interface::Email::MailError(
- To => 'root at localhost',
- Subject => "Extended mailgate error",
- Explanation => "FUBARed",
- MIMEObj => $parser->Entity,
- );
-
- ok( (grep { /^In-Reply-To: $message_id$/ } <$fh>), "Set the In-Reply-To: header properly" );
-}
-
-1;
commit f32a75f5c936ec92df8e350725e3235a42365030
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 15:21:11 2013 +0400
move tests t/ directory
diff --git a/xt/02.create.t b/t/create.t
similarity index 89%
rename from xt/02.create.t
rename to t/create.t
index 8463b57..08dd850 100644
--- a/xt/02.create.t
+++ b/t/create.t
@@ -1,12 +1,9 @@
-#!/usr/bin/perl
-
use strict;
use warnings;
-use Test::More tests => 144;
-
-BEGIN { require 'xt/utils.pl' }
-RT::Init();
+use RT::Extension::CommandByMail::Test tests => undef;
+my $test = 'RT::Extension::CommandByMail::Test';
+RT->Config->Set('MailPlugins', 'Auth::MailFrom', 'Filter::TakeAction');
my $test_ticket_id;
@@ -18,7 +15,7 @@ From: root\@localhost
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -37,7 +34,7 @@ Status: $status
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -56,7 +53,7 @@ FinalPriority: $final_priority
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -82,7 +79,7 @@ FinalPriority: $final_priority
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -106,7 +103,7 @@ $field: $value
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -126,7 +123,7 @@ $field: $value
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -146,7 +143,7 @@ TimeWorked: 5
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -166,7 +163,7 @@ $field: $value
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -186,7 +183,7 @@ AddRequestor: $value
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -204,7 +201,7 @@ DelRequestor: root\@localhost
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -222,7 +219,7 @@ $field: $test_ticket_id
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -258,7 +255,7 @@ CustomField.{$cf_name}: foo
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -282,7 +279,7 @@ CustomField.{$cf_name}: foo
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -332,7 +329,7 @@ CF.{$cf_name}: fro'b
owner test
END
- $id = create_ticket_via_gate( $text );
+ (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $ticket = RT::Ticket->new($RT::SystemUser);
$ticket->Load( $id );
@@ -353,7 +350,7 @@ Cc: $cc
cc test
END
- $id = create_ticket_via_gate( $text );
+ (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $ticket = RT::Ticket->new($RT::SystemUser);
$ticket->Load( $id );
@@ -365,4 +362,4 @@ END
}
-1;
+done_testing();
diff --git a/xt/01.internals.t b/t/internals.t
similarity index 98%
rename from xt/01.internals.t
rename to t/internals.t
index f56a593..64f5942 100644
--- a/xt/01.internals.t
+++ b/t/internals.t
@@ -1,13 +1,7 @@
-#!/usr/bin/perl
-
use strict;
use warnings;
-use Test::More tests => 24;
-
-BEGIN { require 'xt/utils.pl' }
-use_ok('RT');
-RT::LoadConfig();
+use RT::Extension::CommandByMail::Test tests => undef, nodb => 1;
use_ok('RT::Interface::Email::Filter::TakeAction');
@@ -140,3 +134,5 @@ diag( "test _CompileAdditiveForUpdate") if $ENV{'TEST_VERBOSE'};
);
is_deeply(\@res, [[],[]], 'del not current: do nothing');
}
+
+done_testing();
diff --git a/xt/03.update.t b/t/update.t
similarity index 88%
rename from xt/03.update.t
rename to t/update.t
index 3f6253a..86a9355 100644
--- a/xt/03.update.t
+++ b/t/update.t
@@ -1,12 +1,9 @@
-#!/usr/bin/perl
-
use strict;
use warnings;
-use Test::More tests => 134;
-
-BEGIN { require 'xt/utils.pl' }
-RT::Init();
+use RT::Extension::CommandByMail::Test tests => undef;
+my $test = 'RT::Extension::CommandByMail::Test';
+RT->Config->Set('MailPlugins', 'Auth::MailFrom', 'Filter::TakeAction');
my $test_ticket_id;
@@ -18,7 +15,7 @@ From: root\@localhost
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -37,7 +34,7 @@ Status: $status
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -56,7 +53,7 @@ FinalPriority: $final_priority
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -79,7 +76,7 @@ $field: $value
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -99,7 +96,7 @@ $field: $value
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -124,7 +121,7 @@ TimeWorked: 10
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
$obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -150,7 +147,7 @@ TimeWorked: 5
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
$obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -170,7 +167,7 @@ $field: $value
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -192,7 +189,7 @@ AddRequestor: $value
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -210,7 +207,7 @@ DelRequestor: root\@localhost
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -230,7 +227,7 @@ From: root\@localhost
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
ok($id, "created ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -249,7 +246,7 @@ $field: $link_ticket_id
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -285,7 +282,7 @@ CustomField.{$cf_name}: foo
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -305,7 +302,7 @@ Priority: 44
test
END
- my $id = create_ticket_via_gate( $text );
+ my (undef, $id) = $test->send_via_mailgate( $text );
is($id, $test_ticket_id, "updated ticket");
my $obj = RT::Ticket->new( $RT::SystemUser );
$obj->Load( $id );
@@ -316,3 +313,4 @@ END
like($content, qr/Priority: 44/, "invalid Priority command not stripped");
}
+done_testing();
commit bb3fee14b3090e7d1578f07adc71b79c9ffd92aa
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 15:24:47 2013 +0400
remove xt/ directory
diff --git a/Makefile.PL b/Makefile.PL
index 5a4aef0..942c4e7 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -25,10 +25,8 @@ substitute(
RT_BIN_PATH => $bin_path,
RT_SBIN_PATH => $sbin_path,
},
- qw(xt/utils.pl lib/RT/Extension/CommandByMail/Test.pm),
+ qw(lib/RT/Extension/CommandByMail/Test.pm),
);
-author_tests('xt');
-
sign;
WriteAll();
diff --git a/xt/00.load.t b/xt/00.load.t
deleted file mode 100644
index b9375ae..0000000
--- a/xt/00.load.t
+++ /dev/null
@@ -1,30 +0,0 @@
-use Test::More tests => 5;
-
-BEGIN { require 'xt/utils.pl' }
-BEGIN {
- use_ok( 'RT' );
- RT::LoadConfig();
- use_ok( 'RT::Extension::CommandByMail' );
- use_ok( 'RT::Interface::Email::Filter::TakeAction' );
-}
-
-diag( "Testing RT::Extension::CommandByMail $RT::Extension::CommandByMail::VERSION" );
-
-my $new_config = RT->can('Config') && RT->Config->can('Get');
-
-my @plugins = $new_config
- ? RT->Config->Get('Plugins')
- : @RT::Plugins;
-
-my @mail_plugins = $new_config
- ? RT->Config->Get('MailPlugins')
- : @RT::MailPlugins;
-
-my $complain = 0;
-ok((grep { $_ eq 'RT::Extension::CommandByMail' } @plugins), "RT::Extension::CommandByMail is in your config's \@Plugins") or $complain = 1;
-ok((grep { $_ eq 'Filter::TakeAction' } @mail_plugins), "Filter::TakeAction is in your config's \@MailPlugins") or $complain = 1;
-
-if ($complain) {
- diag "Please read through the entire INSTALL documentation for directions on how to set up your config for testing and using this plugin.";
-}
-
diff --git a/xt/pod-coverage.t b/xt/pod-coverage.t
deleted file mode 100644
index 703f91d..0000000
--- a/xt/pod-coverage.t
+++ /dev/null
@@ -1,6 +0,0 @@
-#!perl -T
-
-use Test::More;
-eval "use Test::Pod::Coverage 1.04";
-plan skip_all => "Test::Pod::Coverage 1.04 required for testing POD coverage" if $@;
-all_pod_coverage_ok();
diff --git a/xt/pod.t b/xt/pod.t
deleted file mode 100644
index 976d7cd..0000000
--- a/xt/pod.t
+++ /dev/null
@@ -1,6 +0,0 @@
-#!perl -T
-
-use Test::More;
-eval "use Test::Pod 1.14";
-plan skip_all => "Test::Pod 1.14 required for testing POD" if $@;
-all_pod_files_ok();
diff --git a/xt/utils.pl b/xt/utils.pl
deleted file mode 100644
index 3b1292b..0000000
--- a/xt/utils.pl
+++ /dev/null
@@ -1,58 +0,0 @@
-#!/usr/bin/perl
-
-use strict;
-use warnings;
-
-
-BEGIN {
-### after: push @INC, qw(@RT_LIB_PATH@);
- push @INC, qw(/opt/rt3/local/lib /opt/rt3/lib);
-}
-
-use RT;
-RT::LoadConfig();
-
-use IPC::Open2;
-
-### after: our $mailgate = '@RT_BIN_PATH@/rt-mailgate';
-our $mailgate = '/opt/rt3/bin/rt-mailgate';
-die "Couldn't find mailgate ($mailgate) command" unless -f $mailgate;
-
-$mailgate .= ' --debug';
-$mailgate .= ' --url '. $RT::WebURL;
-
-
-sub run_gate {
- my %args = (
- message => '',
- action => 'correspond',
- queue => 'General',
- @_
- );
- my $cmd = $mailgate
- ." --queue '$args{'queue'}'"
- ." --action $args{'action'}"
- ." 2>&1";
-
- DBIx::SearchBuilder::Record::Cachable->FlushCache;
-
- my ($child_out, $child_in);
- my $pid = open2($child_out, $child_in, $cmd);
- print $child_in $args{'message'};
- close $child_in;
- my $result = do { local $/; <$child_out> };
- return $result;
-}
-
-sub create_ticket_via_gate {
- my $message = shift;
- my $gate_result = run_gate( message => $message );
- $gate_result =~ /Ticket: (\d+)/;
- unless ( $1 ) {
- print STDERR "Couldn't find ticket id in text:\n$gate_result";
- }
- return $1;
-}
-
-1;
-
commit 937bf2ab30a4540ba0f8cefe0077862180c24abb
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 15:26:57 2013 +0400
update M::I
diff --git a/inc/Module/AutoInstall.pm b/inc/Module/AutoInstall.pm
index 60b90ea..aa7aa92 100644
--- a/inc/Module/AutoInstall.pm
+++ b/inc/Module/AutoInstall.pm
@@ -3,11 +3,12 @@ package Module::AutoInstall;
use strict;
use Cwd ();
+use File::Spec ();
use ExtUtils::MakeMaker ();
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.03';
+ $VERSION = '1.06';
}
# special map on pre-defined feature sets
@@ -17,11 +18,14 @@ my %FeatureMap = (
);
# various lexical flags
-my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $HasCPANPLUS );
+my ( @Missing, @Existing, %DisabledTests, $UnderCPAN, $InstallDepsTarget, $HasCPANPLUS );
my (
- $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps
+ $Config, $CheckOnly, $SkipInstall, $AcceptDefault, $TestOnly, $AllDeps,
+ $UpgradeDeps
);
-my ( $PostambleActions, $PostambleUsed );
+my ( $PostambleActions, $PostambleActionsNoTest, $PostambleActionsUpgradeDeps,
+ $PostambleActionsUpgradeDepsNoTest, $PostambleActionsListDeps,
+ $PostambleActionsListAllDeps, $PostambleUsed, $NoTest);
# See if it's a testing or non-interactive session
_accept_default( $ENV{AUTOMATED_TESTING} or ! -t STDIN );
@@ -31,6 +35,10 @@ sub _accept_default {
$AcceptDefault = shift;
}
+sub _installdeps_target {
+ $InstallDepsTarget = shift;
+}
+
sub missing_modules {
return @Missing;
}
@@ -63,6 +71,11 @@ sub _init {
__PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
exit 0;
}
+ elsif ( $arg =~ /^--upgradedeps=(.*)$/ ) {
+ $UpgradeDeps = 1;
+ __PACKAGE__->install( $Config, @Missing = split( /,/, $1 ) );
+ exit 0;
+ }
elsif ( $arg =~ /^--default(?:deps)?$/ ) {
$AcceptDefault = 1;
}
@@ -125,7 +138,7 @@ sub import {
# check entirely since we don't want to have to load (and configure)
# an old CPAN just for a cosmetic message
- $UnderCPAN = _check_lock(1) unless $SkipInstall;
+ $UnderCPAN = _check_lock(1) unless $SkipInstall || $InstallDepsTarget;
while ( my ( $feature, $modules ) = splice( @args, 0, 2 ) ) {
my ( @required, @tests, @skiptests );
@@ -175,7 +188,7 @@ sub import {
}
# XXX: check for conflicts and uninstalls(!) them.
- my $cur = _load($mod);
+ my $cur = _version_of($mod);
if (_version_cmp ($cur, $arg) >= 0)
{
print "loaded. ($cur" . ( $arg ? " >= $arg" : '' ) . ")\n";
@@ -207,6 +220,7 @@ sub import {
$CheckOnly
or ($mandatory and $UnderCPAN)
or $AllDeps
+ or $InstallDepsTarget
or _prompt(
qq{==> Auto-install the }
. ( @required / 2 )
@@ -237,10 +251,17 @@ sub import {
}
}
- if ( @Missing and not( $CheckOnly or $UnderCPAN ) ) {
+ if ( @Missing and not( $CheckOnly or $UnderCPAN) ) {
require Config;
- print
-"*** Dependencies will be installed the next time you type '$Config::Config{make}'.\n";
+ my $make = $Config::Config{make};
+ if ($InstallDepsTarget) {
+ print
+"*** To install dependencies type '$make installdeps' or '$make installdeps_notest'.\n";
+ }
+ else {
+ print
+"*** Dependencies will be installed the next time you type '$make'.\n";
+ }
# make an educated guess of whether we'll need root permission.
print " (You may need to do that as the 'root' user.)\n"
@@ -271,6 +292,10 @@ END_MESSAGE
sub _check_lock {
return unless @Missing or @_;
+ if ($ENV{PERL5_CPANM_IS_RUNNING}) {
+ return _running_under('cpanminus');
+ }
+
my $cpan_env = $ENV{PERL5_CPAN_IS_RUNNING};
if ($ENV{PERL5_CPANPLUS_IS_RUNNING}) {
@@ -324,7 +349,7 @@ sub install {
while ( my ( $pkg, $ver ) = splice( @_, 0, 2 ) ) {
# grep out those already installed
- if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
else {
@@ -332,6 +357,11 @@ sub install {
}
}
+ if ($UpgradeDeps) {
+ push @modules, @installed;
+ @installed = ();
+ }
+
return @installed unless @modules; # nothing to do
return @installed if _check_lock(); # defer to the CPAN shell
@@ -363,7 +393,7 @@ sub install {
# see if we have successfully installed them
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
- if ( _version_cmp( _load($pkg), $ver ) >= 0 ) {
+ if ( _version_cmp( _version_of($pkg), $ver ) >= 0 ) {
push @installed, $pkg;
}
elsif ( $args{do_once} and open( FAILED, '>> .#autoinstall.failed' ) ) {
@@ -463,6 +493,11 @@ sub _cpanplus_config {
} else {
die "*** Cannot convert option $key = '$value' to CPANPLUS version.\n";
}
+ push @config, 'prereqs', $value;
+ } elsif ( $key eq 'force' ) {
+ push @config, $key, $value;
+ } elsif ( $key eq 'notest' ) {
+ push @config, 'skiptest', $value;
} else {
die "*** Cannot convert option $key to CPANPLUS version.\n";
}
@@ -497,10 +532,14 @@ sub _install_cpan {
# set additional options
while ( my ( $opt, $arg ) = splice( @config, 0, 2 ) ) {
( $args{$opt} = $arg, next )
- if $opt =~ /^force$/; # pseudo-option
+ if $opt =~ /^(?:force|notest)$/; # pseudo-option
$CPAN::Config->{$opt} = $arg;
}
+ if ($args{notest} && (not CPAN::Shell->can('notest'))) {
+ die "Your version of CPAN is too old to support the 'notest' pragma";
+ }
+
local $CPAN::Config->{prerequisites_policy} = 'follow';
while ( my ( $pkg, $ver ) = splice( @modules, 0, 2 ) ) {
@@ -519,8 +558,16 @@ sub _install_cpan {
delete $INC{$inc};
}
- my $rv = $args{force} ? CPAN::Shell->force( install => $pkg )
- : CPAN::Shell->install($pkg);
+ my $rv = do {
+ if ($args{force}) {
+ CPAN::Shell->force( install => $pkg )
+ } elsif ($args{notest}) {
+ CPAN::Shell->notest( install => $pkg )
+ } else {
+ CPAN::Shell->install($pkg)
+ }
+ };
+
$rv ||= eval {
$CPAN::META->instance( 'CPAN::Distribution', $obj->cpan_file, )
->{install}
@@ -575,7 +622,7 @@ sub _update_to {
my $ver = shift;
return
- if _version_cmp( _load($class), $ver ) >= 0; # no need to upgrade
+ if _version_cmp( _version_of($class), $ver ) >= 0; # no need to upgrade
if (
_prompt( "==> A newer version of $class ($ver) is required. Install?",
@@ -660,16 +707,30 @@ sub _can_write {
# load a module and return the version it reports
sub _load {
- my $mod = pop; # class/instance doesn't matter
+ my $mod = pop; # method/function doesn't matter
my $file = $mod;
-
$file =~ s|::|/|g;
$file .= '.pm';
-
local $@;
return eval { require $file; $mod->VERSION } || ( $@ ? undef: 0 );
}
+# report version without loading a module
+sub _version_of {
+ my $mod = pop; # method/function doesn't matter
+ my $file = $mod;
+ $file =~ s|::|/|g;
+ $file .= '.pm';
+ foreach my $dir ( @INC ) {
+ next if ref $dir;
+ my $path = File::Spec->catfile($dir, $file);
+ next unless -e $path;
+ require ExtUtils::MM_Unix;
+ return ExtUtils::MM_Unix->parse_version($path);
+ }
+ return undef;
+}
+
# Load CPAN.pm and it's configuration
sub _load_cpan {
return if $CPAN::VERSION and $CPAN::Config and not @_;
@@ -763,6 +824,35 @@ sub _make_args {
: "\$(NOECHO) \$(NOOP)"
);
+ my $deps_list = join( ',', @Missing, @Existing );
+
+ $PostambleActionsUpgradeDeps =
+ "\$(PERL) $0 --config=$config --upgradedeps=$deps_list";
+
+ my $config_notest =
+ join( ',', (UNIVERSAL::isa( $Config, 'HASH' ) ? %{$Config} : @{$Config}),
+ 'notest', 1 )
+ if $Config;
+
+ $PostambleActionsNoTest = (
+ ($missing and not $UnderCPAN)
+ ? "\$(PERL) $0 --config=$config_notest --installdeps=$missing"
+ : "\$(NOECHO) \$(NOOP)"
+ );
+
+ $PostambleActionsUpgradeDepsNoTest =
+ "\$(PERL) $0 --config=$config_notest --upgradedeps=$deps_list";
+
+ $PostambleActionsListDeps =
+ '@$(PERL) -le "print for @ARGV" '
+ . join(' ', map $Missing[$_], grep $_ % 2 == 0, 0..$#Missing);
+
+ my @all = (@Missing, @Existing);
+
+ $PostambleActionsListAllDeps =
+ '@$(PERL) -le "print for @ARGV" '
+ . join(' ', map $all[$_], grep $_ % 2 == 0, 0..$#all);
+
return %args;
}
@@ -797,11 +887,15 @@ sub Write {
sub postamble {
$PostambleUsed = 1;
+ my $fragment;
- return <<"END_MAKE";
+ $fragment .= <<"AUTO_INSTALL" if !$InstallDepsTarget;
config :: installdeps
\t\$(NOECHO) \$(NOOP)
+AUTO_INSTALL
+
+ $fragment .= <<"END_MAKE";
checkdeps ::
\t\$(PERL) $0 --checkdeps
@@ -809,12 +903,28 @@ checkdeps ::
installdeps ::
\t$PostambleActions
+installdeps_notest ::
+\t$PostambleActionsNoTest
+
+upgradedeps ::
+\t$PostambleActionsUpgradeDeps
+
+upgradedeps_notest ::
+\t$PostambleActionsUpgradeDepsNoTest
+
+listdeps ::
+\t$PostambleActionsListDeps
+
+listalldeps ::
+\t$PostambleActionsListAllDeps
+
END_MAKE
+ return $fragment;
}
1;
__END__
-#line 1071
+#line 1193
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 74caf9c..4ecf46b 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -31,7 +31,7 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '1.01';
+ $VERSION = '1.06';
# Storage for the pseudo-singleton
$MAIN = undef;
@@ -451,7 +451,7 @@ sub _version ($) {
}
sub _cmp ($$) {
- _version($_[0]) <=> _version($_[1]);
+ _version($_[1]) <=> _version($_[2]);
}
# Cloned from Params::Util::_CLASS
@@ -467,4 +467,4 @@ sub _CLASS ($) {
1;
-# Copyright 2008 - 2011 Adam Kennedy.
+# Copyright 2008 - 2012 Adam Kennedy.
diff --git a/inc/Module/Install/AuthorTests.pm b/inc/Module/Install/AuthorTests.pm
deleted file mode 100644
index c44931b..0000000
--- a/inc/Module/Install/AuthorTests.pm
+++ /dev/null
@@ -1,59 +0,0 @@
-#line 1
-package Module::Install::AuthorTests;
-
-use 5.005;
-use strict;
-use Module::Install::Base;
-use Carp ();
-
-#line 16
-
-use vars qw{$VERSION $ISCORE @ISA};
-BEGIN {
- $VERSION = '0.002';
- $ISCORE = 1;
- @ISA = qw{Module::Install::Base};
-}
-
-#line 42
-
-sub author_tests {
- my ($self, @dirs) = @_;
- _add_author_tests($self, \@dirs, 0);
-}
-
-#line 56
-
-sub recursive_author_tests {
- my ($self, @dirs) = @_;
- _add_author_tests($self, \@dirs, 1);
-}
-
-sub _wanted {
- my $href = shift;
- sub { /\.t$/ and -f $_ and $href->{$File::Find::dir} = 1 }
-}
-
-sub _add_author_tests {
- my ($self, $dirs, $recurse) = @_;
- return unless $Module::Install::AUTHOR;
-
- my @tests = $self->tests ? (split / /, $self->tests) : 't/*.t';
-
- # XXX: pick a default, later -- rjbs, 2008-02-24
- my @dirs = @$dirs ? @$dirs : Carp::confess "no dirs given to author_tests";
- @dirs = grep { -d } @dirs;
-
- if ($recurse) {
- require File::Find;
- my %test_dir;
- File::Find::find(_wanted(\%test_dir), @dirs);
- $self->tests( join ' ', @tests, map { "$_/*.t" } sort keys %test_dir );
- } else {
- $self->tests( join ' ', @tests, map { "$_/*.t" } sort @dirs );
- }
-}
-
-#line 107
-
-1;
diff --git a/inc/Module/Install/AutoInstall.pm b/inc/Module/Install/AutoInstall.pm
index bc3d172..6efe4fe 100644
--- a/inc/Module/Install/AutoInstall.pm
+++ b/inc/Module/Install/AutoInstall.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -73,6 +73,17 @@ sub auto_install {
);
}
+sub installdeps_target {
+ my ($self, @args) = @_;
+
+ $self->include('Module::AutoInstall');
+ require Module::AutoInstall;
+
+ Module::AutoInstall::_installdeps_target(1);
+
+ $self->auto_install(@args);
+}
+
sub auto_install_now {
my $self = shift;
$self->auto_install(@_);
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index d3662c9..802844a 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -4,7 +4,7 @@ package Module::Install::Base;
use strict 'vars';
use vars qw{$VERSION};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
}
# Suspend handler for "redefined" warnings
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index 276409a..22167b8 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -3,13 +3,12 @@ package Module::Install::Can;
use strict;
use Config ();
-use File::Spec ();
use ExtUtils::MakeMaker ();
use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -29,7 +28,7 @@ sub can_use {
eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}
-# check if we can run some command
+# Check if we can run some command
sub can_run {
my ($self, $cmd) = @_;
@@ -38,14 +37,88 @@ sub can_run {
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
next if $dir eq '';
- my $abs = File::Spec->catfile($dir, $_[1]);
+ require File::Spec;
+ my $abs = File::Spec->catfile($dir, $cmd);
return $abs if (-x $abs or $abs = MM->maybe_command($abs));
}
return;
}
-# can we locate a (the) C compiler
+# Can our C compiler environment build XS files
+sub can_xs {
+ my $self = shift;
+
+ # Ensure we have the CBuilder module
+ $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
+
+ # Do we have the configure_requires checker?
+ local $@;
+ eval "require ExtUtils::CBuilder;";
+ if ( $@ ) {
+ # They don't obey configure_requires, so it is
+ # someone old and delicate. Try to avoid hurting
+ # them by falling back to an older simpler test.
+ return $self->can_cc();
+ }
+
+ # Do we have a working C compiler
+ my $builder = ExtUtils::CBuilder->new(
+ quiet => 1,
+ );
+ unless ( $builder->have_compiler ) {
+ # No working C compiler
+ return 0;
+ }
+
+ # Write a C file representative of what XS becomes
+ require File::Temp;
+ my ( $FH, $tmpfile ) = File::Temp::tempfile(
+ "compilexs-XXXXX",
+ SUFFIX => '.c',
+ );
+ binmode $FH;
+ print $FH <<'END_C';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+ return 0;
+}
+
+int boot_sanexs() {
+ return 1;
+}
+
+END_C
+ close $FH;
+
+ # Can the C compiler access the same headers XS does
+ my @libs = ();
+ my $object = undef;
+ eval {
+ local $^W = 0;
+ $object = $builder->compile(
+ source => $tmpfile,
+ );
+ @libs = $builder->link(
+ objects => $object,
+ module_name => 'sanexs',
+ );
+ };
+ my $result = $@ ? 0 : 1;
+
+ # Clean up all the build files
+ foreach ( $tmpfile, $object, @libs ) {
+ next unless defined $_;
+ 1 while unlink;
+ }
+
+ return $result;
+}
+
+# Can we locate a (the) C compiler
sub can_cc {
my $self = shift;
my @chunks = split(/ /, $Config::Config{cc}) or return;
@@ -78,4 +151,4 @@ if ( $^O eq 'cygwin' ) {
__END__
-#line 156
+#line 236
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index 093cb7a..bee0c4f 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
index 90cc979..8310e4c 100644
--- a/inc/Module/Install/Include.pm
+++ b/inc/Module/Install/Include.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 4c71003..7052f36 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -8,7 +8,7 @@ use Fcntl qw/:flock :seek/;
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -215,18 +215,22 @@ sub write {
require ExtUtils::MakeMaker;
if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
- # MakeMaker can complain about module versions that include
- # an underscore, even though its own version may contain one!
- # Hence the funny regexp to get rid of it. See RT #35800
- # for details.
- my $v = $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/;
- $self->build_requires( 'ExtUtils::MakeMaker' => $v );
- $self->configure_requires( 'ExtUtils::MakeMaker' => $v );
+ # This previous attempted to inherit the version of
+ # ExtUtils::MakeMaker in use by the module author, but this
+ # was found to be untenable as some authors build releases
+ # using future dev versions of EU:MM that nobody else has.
+ # Instead, #toolchain suggests we use 6.59 which is the most
+ # stable version on CPAN at time of writing and is, to quote
+ # ribasushi, "not terminally fucked, > and tested enough".
+ # TODO: We will now need to maintain this over time to push
+ # the version up as new versions are released.
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.59 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.59 );
} else {
# Allow legacy-compatibility with 5.005 by depending on the
# most recent EU:MM that supported 5.005.
- $self->build_requires( 'ExtUtils::MakeMaker' => 6.42 );
- $self->configure_requires( 'ExtUtils::MakeMaker' => 6.42 );
+ $self->build_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
}
# Generate the MakeMaker params
@@ -241,7 +245,6 @@ in a module, and provide its file path via 'version_from' (or
'all_from' if you prefer) in Makefile.PL.
EOT
- $DB::single = 1;
if ( $self->tests ) {
my @tests = split ' ', $self->tests;
my %seen;
@@ -412,4 +415,4 @@ sub postamble {
__END__
-#line 541
+#line 544
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 3b01e09..58430f3 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
@@ -151,15 +151,21 @@ sub install_as_site { $_[0]->installdirs('site') }
sub install_as_vendor { $_[0]->installdirs('vendor') }
sub dynamic_config {
- my $self = shift;
- unless ( @_ ) {
- warn "You MUST provide an explicit true/false value to dynamic_config\n";
- return $self;
+ my $self = shift;
+ my $value = @_ ? shift : 1;
+ if ( $self->{values}->{dynamic_config} ) {
+ # Once dynamic we never change to static, for safety
+ return 0;
}
- $self->{values}->{dynamic_config} = $_[0] ? 1 : 0;
+ $self->{values}->{dynamic_config} = $value ? 1 : 0;
return 1;
}
+# Convenience command
+sub static_config {
+ shift->dynamic_config(0);
+}
+
sub perl_version {
my $self = shift;
return $self->{values}->{perl_version} unless @_;
@@ -170,7 +176,7 @@ sub perl_version {
# Normalize the version
$version = $self->_perl_version($version);
- # We don't support the reall old versions
+ # We don't support the really old versions
unless ( $version >= 5.005 ) {
die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
}
@@ -582,7 +588,7 @@ sub bugtracker_from {
sub requires_from {
my $self = shift;
my $content = Module::Install::_readperl($_[0]);
- my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
while ( @requires ) {
my $module = shift @requires;
my $version = shift @requires;
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 73b9cda..ce01018 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,7 +8,7 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.29';
+our $VERSION = '0.30';
use FindBin;
use File::Glob ();
@@ -129,18 +129,7 @@ install ::
my %has_etc;
if ( File::Glob::bsd_glob("$FindBin::Bin/etc/schema.*") ) {
-
- # got schema, load factory module
$has_etc{schema}++;
- $self->load('RTxFactory');
- $self->postamble(<< ".");
-factory ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
-
-dropdb ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
-
-.
}
if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) {
$has_etc{acl}++;
@@ -164,28 +153,19 @@ dropdb ::
print "For first-time installation, type 'make initdb'.\n";
my $initdb = '';
$initdb .= <<"." if $has_etc{schema};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema \$(NAME) \$(VERSION)))"
.
$initdb .= <<"." if $has_etc{acl};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl \$(NAME) \$(VERSION)))"
.
$initdb .= <<"." if $has_etc{initialdata};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert \$(NAME) \$(VERSION)))"
.
$self->postamble("initdb ::\n$initdb\n");
$self->postamble("initialize-database ::\n$initdb\n");
}
}
-sub RTxInit {
- unshift @INC, substr( delete( $INC{'RT.pm'} ), 0, -5 ) if $INC{'RT.pm'};
- require RT;
- RT::LoadConfig();
- RT::ConnectToDatabase();
-
- die "Cannot load RT" unless $RT::Handle and $RT::DatabaseType;
-}
-
# stolen from RT::Handle so we work on 3.6 (cmp_versions came in with 3.8)
{ my %word = (
a => -4,
@@ -228,4 +208,4 @@ sub requires_rt {
__END__
-#line 348
+#line 328
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index 3139a63..eeaa3fe 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index 1f724a7..85d8018 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -6,7 +6,7 @@ use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '1.01';
+ $VERSION = '1.06';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
commit b88f6d79f091fbb44dcbe0893b8dae893649f67d
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 15:27:30 2013 +0400
require at least some perl version, update META
diff --git a/META.yml b/META.yml
index 823124f..fc0c3d4 100644
--- a/META.yml
+++ b/META.yml
@@ -4,13 +4,14 @@ author:
- 'Jesse Vincent C<< <jesse at bestpractical.com> >>'
- 'Jesse Vincent <jesse at bestpractical.com>'
build_requires:
- ExtUtils::MakeMaker: 6.42
+ ExtUtils::MakeMaker: 6.59
IPC::Open2: 0
Test::More: 0
configure_requires:
- ExtUtils::MakeMaker: 6.42
+ ExtUtils::MakeMaker: 6.59
distribution_type: module
-generated_by: 'Module::Install version 1.01'
+dynamic_config: 1
+generated_by: 'Module::Install version 1.06'
license: perl
meta-spec:
url: http://module-build.sourceforge.net/META-spec-v1.4.html
@@ -19,10 +20,11 @@ name: RT-Extension-CommandByMail
no_index:
directory:
- inc
- - xt
+ - t
requires:
MIME::Entity: 5.420
UNIVERSAL::require: 0
+ perl: 5.8.3
resources:
license: http://dev.perl.org/licenses/
version: 0.10
diff --git a/lib/RT/Extension/CommandByMail.pm b/lib/RT/Extension/CommandByMail.pm
index 9623766..866c27c 100644
--- a/lib/RT/Extension/CommandByMail.pm
+++ b/lib/RT/Extension/CommandByMail.pm
@@ -1,3 +1,4 @@
+use 5.008003;
package RT::Extension::CommandByMail;
our $VERSION = '0.10';
commit bf7a3688ecdc1dca3dcf27c81f26c73e0c140a7e
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 15:28:18 2013 +0400
ignore MYMETA files and t/tmp/
diff --git a/.gitignore b/.gitignore
index bfe4fd0..38edb49 100644
--- a/.gitignore
+++ b/.gitignore
@@ -3,3 +3,5 @@ Makefile
blib
pm_to_blib
*.swp
+MYMETA.*
+t/tmp/
commit 33d023989f6a96c3280679cbce3e83be29c54252
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 15:30:14 2013 +0400
get rid of uninit warnings
diff --git a/lib/RT/Interface/Email/Filter/TakeAction.pm b/lib/RT/Interface/Email/Filter/TakeAction.pm
index 7e4030e..12f8d82 100644
--- a/lib/RT/Interface/Email/Filter/TakeAction.pm
+++ b/lib/RT/Interface/Email/Filter/TakeAction.pm
@@ -201,6 +201,8 @@ sub GetCurrentUser {
foreach my $line (@content) {
next if $line =~ /^\s*$/ && ! $found_pseudoheaders;
last if $line !~ /^(?:(\S+(?:{.*})?)\s*?:\s*?(.*)\s*?|)$/;
+ next unless defined $1;
+
$found_pseudoheaders = 1;
push( @items, $1 => $2 );
$RT::Logger->debug("Found pseudoheader: $1 => $2");
commit 337a8c8983a87ce904dbacba474d6e383cab09d8
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 15:31:24 2013 +0400
get rid of uninit warning
diff --git a/lib/RT/Interface/Email/Filter/TakeAction.pm b/lib/RT/Interface/Email/Filter/TakeAction.pm
index 12f8d82..816a9bb 100644
--- a/lib/RT/Interface/Email/Filter/TakeAction.pm
+++ b/lib/RT/Interface/Email/Filter/TakeAction.pm
@@ -208,7 +208,7 @@ sub GetCurrentUser {
$RT::Logger->debug("Found pseudoheader: $1 => $2");
}
my %cmds;
- while ( my $key = _CanonicalizeCommand( lc shift @items ) ) {
+ while ( my $key = _CanonicalizeCommand( shift @items ) ) {
my $val = shift @items;
# strip leading and trailing spaces
$val =~ s/^\s+|\s+$//g;
@@ -650,6 +650,9 @@ sub _SetAttribute {
sub _CanonicalizeCommand {
my $key = shift;
+ return $key unless defined $key;
+
+ $key = lc $key;
# CustomField commands
$key =~ s/^(add|del|)c(?:ustom)?-?f(?:ield)?\.?[({\[](.*)[)}\]]$/$1customfield{$2}/i;
return $key;
commit 06bee1c36d6e3787c608e9ab77cb6a5ac99b4a10
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 15:55:35 2013 +0400
fix reporting of dates changes
intention of the code is to store original value
in the results, but it was stored incorrectly, so we
end up with two records in results: first with success
and ISO date, second with value only that is treated
as failure.
diff --git a/lib/RT/Interface/Email/Filter/TakeAction.pm b/lib/RT/Interface/Email/Filter/TakeAction.pm
index 816a9bb..02e0809 100644
--- a/lib/RT/Interface/Email/Filter/TakeAction.pm
+++ b/lib/RT/Interface/Email/Filter/TakeAction.pm
@@ -284,7 +284,7 @@ sub GetCurrentUser {
);
_SetAttribute( $ticket_as_user, $attribute, $date->ISO,
\%results );
- $results{ lc $attribute }->{value} = $cmds{ lc $attribute };
+ $results{ $attribute }->{value} = $cmds{ lc $attribute };
}
foreach my $type ( @WATCHER_ATTRIBUTES ) {
commit 9ca419e0c82c4b79e4727e4b323f8f7af98c3e1c
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 15:59:55 2013 +0400
pass value as email to AddWatcher when we couldn't load user
diff --git a/lib/RT/Interface/Email/Filter/TakeAction.pm b/lib/RT/Interface/Email/Filter/TakeAction.pm
index 02e0809..eef3784 100644
--- a/lib/RT/Interface/Email/Filter/TakeAction.pm
+++ b/lib/RT/Interface/Email/Filter/TakeAction.pm
@@ -317,7 +317,10 @@ sub GetCurrentUser {
$user->Load($text) unless $user->id;
my ( $val, $msg ) = $ticket_as_user->AddWatcher(
Type => $type,
- PrincipalId => $user->PrincipalId,
+ $user->id
+ ? (PrincipalId => $user->PrincipalId)
+ : (Email => $text)
+ ,
);
push @{ $results{ 'Add'. $type } }, {
value => $text,
commit 49add88ab69a0ed3ec4c091f5b8832eb400aa1d0
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 16:00:44 2013 +0400
support transaction custom fields
diff --git a/lib/RT/Interface/Email/Filter/TakeAction.pm b/lib/RT/Interface/Email/Filter/TakeAction.pm
index eef3784..4d71aab 100644
--- a/lib/RT/Interface/Email/Filter/TakeAction.pm
+++ b/lib/RT/Interface/Email/Filter/TakeAction.pm
@@ -128,6 +128,19 @@ Short forms:
AddCF.{<CFName>}: <custom field value>
DelCF.{<CFName>}: <custom field value>
+=head3 Transaction Custom field values
+
+Manage custom field values of transactions. Could be used multiple times. (The curly braces
+are literal.)
+
+ TransactionCustomField.{<CFName>}: <custom field value>
+
+Short forms:
+
+ TxnCustomField.{<CFName>}: <custom field value>
+ TransactionCF.{<CFName>}: <custom field value>
+ TxnCF.{<CFName>}: <custom field value>
+
=cut
=head2 GetCurrentUser
@@ -245,6 +258,8 @@ sub GetCurrentUser {
$queue->Load( $args{'Queue'}->id );
}
+ my $transaction;
+
# If we're updating.
if ( $args{'Ticket'}->id ) {
$ticket_as_user->Load( $args{'Ticket'}->id );
@@ -343,7 +358,7 @@ sub GetCurrentUser {
}
my $method = ucfirst $args{'Action'};
- my ($status, $msg) = $ticket_as_user->$method(
+ (my $status, my $msg, $transaction) = $ticket_as_user->$method(
TimeTaken => $time_taken,
MIMEObj => $args{'Message'},
);
@@ -447,13 +462,6 @@ sub GetCurrentUser {
);
}
- _ReportResults(
- Ticket => $args{'Ticket'},
- Results => \%results,
- Message => $args{'Message'}
- );
- return ( $args{'CurrentUser'}, -2 );
-
} else {
my %create_args = ();
@@ -550,13 +558,40 @@ sub GetCurrentUser {
return ($args{'CurrentUser'}, $args{'AuthLevel'});
}
+ $transaction = RT::Transaction->new( $ticket_as_user->CurrentUser );
+ $transaction->Load( $txn_id );
- _ReportResults( Results => \%results, Message => $args{'Message'} );
+ }
- # now that we've created a ticket, we abort so we don't create another.
- $args{'Ticket'}->Load( $id );
- return ( $args{'CurrentUser'}, -2 );
+ if ( $transaction && $transaction->id ) {
+ my $custom_fields = $transaction->CustomFields;
+ while ( my $cf = $custom_fields->Next ) {
+ my $cmd = 'TransactionCustomField{'. $cf->Name .'}';
+ my @values = ($cmds{ lc $cmd });
+ next unless @values && $values[0];
+
+ @values = @{ $values[0] } if ref $values[0] eq 'ARRAY';
+ foreach my $value ( @values ) {
+ my ($status, $msg) = $transaction->AddCustomFieldValue(
+ Field => $cf->Name, Value => $value,
+ );
+ push @{ $results{ $cmd } ||= [] }, {
+ value => $value, result => $status, message => $msg,
+ };
+ }
+ }
}
+
+ _ReportResults(
+ Ticket => $args{'Ticket'},
+ Results => \%results,
+ Message => $args{'Message'},
+ );
+
+ # make sure ticket is loaded
+ $args{'Ticket'}->Load( $transaction->ObjectId );
+
+ return ( $args{'CurrentUser'}, -2 );
}
sub _ParseAdditiveCommand {
@@ -658,12 +693,14 @@ sub _CanonicalizeCommand {
$key = lc $key;
# CustomField commands
$key =~ s/^(add|del|)c(?:ustom)?-?f(?:ield)?\.?[({\[](.*)[)}\]]$/$1customfield{$2}/i;
+ $key =~ s/^(?:transaction|txn)c(?:ustom)?-?f(?:ield)?\.?[({\[](.*)[)}\]]$/transactioncustomfield{$1}/i;
return $key;
}
sub _CheckCommand {
my ($cmd, $val) = (lc shift, shift);
return 1 if $cmd =~ /^(add|del|)customfield{.*}$/i;
+ return 1 if $cmd =~ /^transactioncustomfield{.*}$/i;
if ( grep $cmd eq lc $_, @REGULAR_ATTRIBUTES, @TIME_ATTRIBUTES, @DATE_ATTRIBUTES ) {
return 1 unless ref $val;
return (0, "Command '$cmd' doesn't support multiple values");
@@ -684,7 +721,7 @@ sub _ReportResults {
my %args = ( Ticket => undef, Message => undef, Results => {}, @_ );
my $msg = '';
- unless ( $args{'Ticket'} ) {
+ unless ( $args{'Ticket'} && $args{'Ticket'}->id ) {
$msg .= $args{'Results'}{'Create'}{'message'} || '';
$msg .= "\n" if $msg;
delete $args{'Results'}{'Create'};
diff --git a/t/txn-cfs.t b/t/txn-cfs.t
new file mode 100644
index 0000000..1bf64fa
--- /dev/null
+++ b/t/txn-cfs.t
@@ -0,0 +1,71 @@
+use strict;
+use warnings;
+
+use RT::Extension::CommandByMail::Test tests => undef;
+my $test = 'RT::Extension::CommandByMail::Test';
+RT->Config->Set('MailPlugins', 'Auth::MailFrom', 'Filter::TakeAction');
+
+my $cf_name = 'Test CF';
+{
+ my $cf = RT::CustomField->new( RT->SystemUser );
+ my ($status, $msg) = $cf->Create(
+ Name => $cf_name,
+ Type => 'Freeform',
+ MaxValues => 0,
+ LookupType => RT::Transaction->CustomFieldLookupType,
+ );
+ ok $status, "created a CF" or diag "error: $msg";
+ ($status, $msg) = $cf->AddToObject( RT::Queue->new( RT->SystemUser ) );
+ ok $status, "applied CF" or diag "error: $msg";
+}
+
+my $test_ticket_id;
+
+diag("txn CFs on create") if $ENV{'TEST_VERBOSE'};
+{
+ my $text = <<END;
+Subject: test
+From: root\@localhost
+
+TxnCF{$cf_name}: foo
+TxnCF{$cf_name}: bar
+END
+ my (undef, $id) = $test->send_via_mailgate( $text );
+ ok($id, "created ticket");
+ my $obj = RT::Ticket->new( $RT::SystemUser );
+ $obj->Load( $id );
+ is($obj->id, $id, "loaded ticket");
+
+ my @values = sort map $_->Content,
+ @{ $obj->Transactions->First->CustomFieldValues( $cf_name )->ItemsArrayRef };
+ is_deeply \@values, [qw(bar foo)];
+
+ $test_ticket_id = $obj->id;
+}
+
+diag("txn CFs on update") if $ENV{'TEST_VERBOSE'};
+{
+ my $text = <<END;
+Subject: [$RT::rtname #$test_ticket_id] test
+From: root\@localhost
+
+TxnCF{$cf_name}: foo
+TxnCF{$cf_name}: bar
+END
+ my (undef, $id) = $test->send_via_mailgate( $text );
+ ok($id, "created ticket");
+ my $obj = RT::Ticket->new( $RT::SystemUser );
+ $obj->Load( $id );
+ is($obj->id, $id, "loaded ticket");
+
+ my $txns = $obj->Transactions;
+ $txns->Limit( FIELD => 'Type', VALUE => 'Correspond' );
+
+ my @values = sort map $_->Content,
+ @{ $txns->First->CustomFieldValues( $cf_name )->ItemsArrayRef };
+ is_deeply \@values, [qw(bar foo)];
+
+ $test_ticket_id = $obj->id;
+}
+
+done_testing();
commit 15247e139287049153a6b0c598b8950186b175b5
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 16:04:31 2013 +0400
update changelog
diff --git a/Changes b/Changes
index d0ed6e8..44e12e7 100644
--- a/Changes
+++ b/Changes
@@ -1,5 +1,13 @@
Revision history for RT-Extension-CommandByMail
+0.11
+* get rid of uninit warnings
+* make tests create DBs rather then re-use production
+* use RT's infrastructure in tests
+* fix reporting for dates changes
+* handle adding watchers when user is not in the DB
+* support Transaction Custom Fields
+
0.10
* test fixes for 4.0
* skip on unloaded current user
commit c4d5de4440e5456bc23ff3fd800a4e4703fe8fcd
Author: Ruslan Zakirov <ruz at bestpractical.com>
Date: Thu Feb 7 16:10:40 2013 +0400
bump version, 0.11
diff --git a/MANIFEST b/MANIFEST
index 77232a7..59b93e9 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,7 +1,6 @@
Changes
inc/Module/AutoInstall.pm
inc/Module/Install.pm
-inc/Module/Install/AuthorTests.pm
inc/Module/Install/AutoInstall.pm
inc/Module/Install/Base.pm
inc/Module/Install/Can.pm
@@ -15,6 +14,7 @@ inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
INSTALL
lib/RT/Extension/CommandByMail.pm
+lib/RT/Extension/CommandByMail/Test.pm
lib/RT/Interface/Email/Filter/TakeAction.pm
Makefile.PL
MANIFEST This list of files
@@ -26,11 +26,7 @@ patch/command_by_email-0.1-RT-3.4.5.patch
patch/command_by_email-0.1-RT-3.6.0.patch
patch/errors_in_reply_to-RT-3.6.1.patch
README
-xt/00.load.t
-xt/01.internals.t
-xt/02.create.t
-xt/03.update.t
-xt/04.send.t
-xt/pod-coverage.t
-xt/pod.t
-xt/utils.pl
+t/create.t
+t/internals.t
+t/txn-cfs.t
+t/update.t
diff --git a/META.yml b/META.yml
index fc0c3d4..2e8a5ec 100644
--- a/META.yml
+++ b/META.yml
@@ -27,4 +27,4 @@ requires:
perl: 5.8.3
resources:
license: http://dev.perl.org/licenses/
-version: 0.10
+version: 0.11
diff --git a/lib/RT/Extension/CommandByMail.pm b/lib/RT/Extension/CommandByMail.pm
index 866c27c..bc6eba7 100644
--- a/lib/RT/Extension/CommandByMail.pm
+++ b/lib/RT/Extension/CommandByMail.pm
@@ -1,7 +1,7 @@
use 5.008003;
package RT::Extension::CommandByMail;
-our $VERSION = '0.10';
+our $VERSION = '0.11';
1;
__END__
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list