[Bps-public-commit] RT-Extension-MandatoryOnTransition branch, master, created. 0.03
Thomas Sibley
trs at bestpractical.com
Wed Feb 27 14:32:08 EST 2013
The branch, master has been created
at bd9adddddc3f64baccd32aaba9e95ce1bc02dfc6 (commit)
- Log -----------------------------------------------------------------
commit 97048d87e292d699e85f039635161dddacc29661
Author: Thomas Sibley <trs at bestpractical.com>
Date: Thu Jul 12 13:52:18 2012 -0700
Initial framework
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..e34e799
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,13 @@
+blib*
+Makefile
+Makefile.old
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+cover_db
+pod2htm*.tmp
+/RT-Extension-MandatoryOnTransition*
+README
+*.bak
+*.swp
+/MYMETA.*
diff --git a/Makefile.PL b/Makefile.PL
new file mode 100644
index 0000000..cc6a2df
--- /dev/null
+++ b/Makefile.PL
@@ -0,0 +1,12 @@
+use inc::Module::Install;
+
+
+RTx 'RT-Extension-MandatoryOnTransition';
+all_from 'lib/RT/Extension/MandatoryOnTransition.pm';
+readme_from 'lib/RT/Extension/MandatoryOnTransition.pm';
+license 'gplv2';
+
+requires_rt('4.0.0');
+
+sign;
+WriteAll;
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
new file mode 100644
index 0000000..1360d0a
--- /dev/null
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -0,0 +1,83 @@
+use strict;
+use warnings;
+package RT::Extension::MandatoryOnTransition;
+
+our $VERSION = '0.01';
+
+=head1 NAME
+
+RT-Extension-MandatoryOnTransition - Require core and custom fields on status transitions
+
+=head1 DESCRIPTION
+
+=head1 CAVEATS
+
+This extension does B<not> affect "quick actions" (those without an update
+type) configured in your lifecycle (and appearing in the ticket Actions menu).
+If you're requiring fields on resolve, for example, and don't want folks to
+have a "Quick Resolve" button that skips the required fields, adjust your
+lifecycle config to provide an update type (i.e make it a non-quick action).
+
+Quick actions may be supported in a future release.
+
+=head1 INSTALLATION
+
+=over
+
+=item perl Makefile.PL
+
+=item make
+
+=item make install
+
+May need root permissions
+
+=item Edit your /opt/rt4/etc/RT_SiteConfig.pm
+
+Add this line:
+
+ Set(@Plugins, qw(RT::Extension::MandatoryOnTransition));
+
+or add C<RT::Extension::MandatoryOnTransition> to your existing C<@Plugins> line.
+
+Then configure which fields should be mandatory on certain status changes
+(either globally or in a specific queue). An example making two custom fields
+mandatory before resolving a ticket in the Helpdesk queue:
+
+ Set(%MandatoryOnTransition,
+ Helpdesk => {
+ '* -> resolved' => ['CF.{Resolution}', 'CF.{Problem area}'],
+ });
+
+The transition syntax is similar to that found in RT's Lifecycles.
+
+=item Clear your mason cache
+
+ rm -rf /opt/rt4/var/mason_data/obj
+
+=item Restart your webserver
+
+=back
+
+=head1 AUTHOR
+
+Thomas Sibley <trs at bestpractical.com>
+
+=head1 BUGS
+
+All bugs should be reported via
+L<http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-MandatoryOnTransition>
+or L<bug-RT-Extension-MandatoryOnTransition at rt.cpan.org>.
+
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is Copyright (c) 2012 by Best Practical Solutions
+
+This is free software, licensed under:
+
+ The GNU General Public License, Version 2, June 1991
+
+=cut
+
+1;
commit bd147bdedc5a0b908bf5f7e58f7b926e04a9211b
Author: Thomas Sibley <trs at bestpractical.com>
Date: Mon Jul 23 19:07:30 2012 -0700
Fully functional implementation for core fields and CFs on Update.html
diff --git a/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Elements/EditCustomFields/MassageCustomFields b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Elements/EditCustomFields/MassageCustomFields
new file mode 100644
index 0000000..1075e8b
--- /dev/null
+++ b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Elements/EditCustomFields/MassageCustomFields
@@ -0,0 +1,10 @@
+<%args>
+$CustomFields
+$Named => []
+</%args>
+<%init>
+return unless @$Named;
+
+$CustomFields->Limit( FIELD => 'Name', VALUE => $_, SUBCLAUSE => 'names', ENTRYAGGREGRATOR => 'OR' )
+ for @$Named;
+</%init>
diff --git a/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/AfterWorked b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/AfterWorked
new file mode 100644
index 0000000..8129e75
--- /dev/null
+++ b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/AfterWorked
@@ -0,0 +1,17 @@
+<%args>
+$Ticket
+</%args>
+<%init>
+my ($core, $cfs) = RT::Extension::MandatoryOnTransition->RequiredFields(
+ Ticket => $Ticket,
+ To => $ARGS{'Status'} || $ARGS{'DefaultStatus'},
+);
+return unless @$cfs;
+</%init>
+%# 'Named' is handled by this extension in the MassageCustomFields callback
+<& /Ticket/Elements/EditCustomFields,
+ %ARGS,
+ TicketObj => $Ticket,
+ InTable => 1,
+ Named => $cfs,
+ &>
diff --git a/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate
new file mode 100644
index 0000000..7365052
--- /dev/null
+++ b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate
@@ -0,0 +1,82 @@
+<%args>
+$TicketObj
+$ARGSRef
+$skip_update
+$results
+</%args>
+<%init>
+my ($core, $cfs) = RT::Extension::MandatoryOnTransition->RequiredFields(
+ Ticket => $TicketObj,
+ To => $ARGSRef->{'Status'},
+);
+return unless @$core or @$cfs;
+
+my @errors;
+
+my @core_allowed = qw(TimeWorked TimeTaken Content);
+my @core_ticket = qw(TimeWorked);
+my %core_for_update = (
+ TimeWorked => 'UpdateTimeWorked',
+ TimeTaken => 'UpdateTimeWorked',
+ Content => 'UpdateContent',
+);
+
+# Check core fields, after canonicalization for update
+for my $field (@$core) {
+ unless (grep { $_ eq $field } @core_allowed) {
+ RT->Logger->warning("Skipping unsupported core field '$field' during mandatory checks");
+ next;
+ }
+
+ # Will we have a value on update?
+ my $arg = $core_for_update{$field} || $field;
+ next if defined $ARGSRef->{$arg} and length $ARGSRef->{$arg};
+
+ # Do we have a value currently?
+ next if grep { $_ eq $field } @core_ticket and $TicketObj->$field();
+
+ (my $label = $field) =~ s/(?<=[a-z])(?=[A-Z])/ /g; # /
+ push @errors, loc("[_1] is required when changing Status to [_2]", $label, $ARGSRef->{Status});
+}
+
+# Find the CFs we want
+my $CFs = $TicketObj->CustomFields;
+$CFs->Limit( FIELD => 'Name', VALUE => $_, SUBCLAUSE => 'names', ENTRYAGGREGRATOR => 'OR' )
+ for @$cfs;
+
+# Validate them
+my $ValidCFs = $m->comp(
+ '/Elements/ValidateCustomFields',
+ CustomFields => $CFs,
+ NamePrefix => "Object-RT::Ticket-".$TicketObj->Id."-CustomField-",
+ ARGSRef => $ARGSRef
+);
+
+# Check validation results and mandatory-ness
+while (my $cf = $CFs->Next) {
+ # Is there a validation error?
+ if ( not $ValidCFs and my $msg = $m->notes('InvalidField-' . $cf->Id)) {
+ push @errors, loc($cf->Name) . ': ' . $msg;
+ next;
+ }
+
+ # Do we have a submitted value for update?
+ my $arg = "Object-RT::Ticket-".$TicketObj->Id."-CustomField-".$cf->Id."-Value";
+ my $value = ($ARGSRef->{"${arg}s-Magic"} and exists $ARGSRef->{"${arg}s"})
+ ? $ARGSRef->{$arg . "s"}
+ : $ARGSRef->{$arg};
+ next if defined $value and length $value;
+
+ # Is there a current value? (Particularly important for Date/Datetime CFs
+ # since they don't submit a value on update.)
+ next if $cf->ValuesForObject($TicketObj)->Count;
+
+ push @errors, loc("[_1] is required when changing Status to [_2]", $cf->Name, $ARGSRef->{Status});
+}
+
+if (@errors) {
+ RT->Logger->debug("Preventing update because of missing mandatory fields");
+ $$skip_update = 1;
+ push @$results, @errors;
+}
+</%init>
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index 1360d0a..32f1176 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -6,18 +6,68 @@ our $VERSION = '0.01';
=head1 NAME
-RT-Extension-MandatoryOnTransition - Require core and custom fields on status transitions
+RT-Extension-MandatoryOnTransition - Require core fields and ticket custom fields on status transitions
=head1 DESCRIPTION
+This RT extension enforces that certain fields have values before tickets are
+explicitly moved to or from specified statuses. If you list custom fields
+which must have a value before a ticket is resolved, those custom fields will
+automatically show up on the "Resolve" page. The reply/comment won't be
+allowed until a value is provided.
+
+See the configuration example under L</INSTALLATION>.
+
+=head2 Supported fields
+
+This extension only enforces mandatory-ness on defined status transitions.
+
+=head3 Basics
+
+Currently the following are supported:
+
+=over 4
+
+=item Content
+
+Requires an update message (reply/comment text) before the transition.
+
+=item TimeWorked
+
+Requires the ticket has a non-zero amount of Time Worked recorded already B<or>
+that time worked will be recorded with the current reply/comment in the Worked
+field on the update page.
+
+=item TimeTaken
+
+Requires that the Worked field on the update page is non-zero.
+
+=back
+
+A larger set of basic fields may be supported in future releases. If you'd
+like to see additional fields added, please email your request to the bug
+address at the bottom of this documentation.
+
+=head3 Custom fields
+
+Ticket custom fields of all types are supported.
+
=head1 CAVEATS
+=head2 Custom field validation (I<Input must match [Mandatory]>)
+
+The custom fields enforced by this extension are validated by the standard RT
+rules. If you've set Validation patterns for your custom fields, those will be
+checked before mandatory-ness is checked. B<< Setting a CFs Validation to
+C<(?#Mandatory).> will not magically make it enforced by this extension. >>
+
+=head2 Actions menu
+
This extension does B<not> affect "quick actions" (those without an update
type) configured in your lifecycle (and appearing in the ticket Actions menu).
If you're requiring fields on resolve, for example, and don't want folks to
have a "Quick Resolve" button that skips the required fields, adjust your
lifecycle config to provide an update type (i.e make it a non-quick action).
-
Quick actions may be supported in a future release.
=head1 INSTALLATION
@@ -32,24 +82,42 @@ Quick actions may be supported in a future release.
May need root permissions
-=item Edit your /opt/rt4/etc/RT_SiteConfig.pm
+=item Enable and configure this extension
-Add this line:
+Add this line to </opt/rt4/etc/RT_SiteConfig.pm>:
Set(@Plugins, qw(RT::Extension::MandatoryOnTransition));
or add C<RT::Extension::MandatoryOnTransition> to your existing C<@Plugins> line.
Then configure which fields should be mandatory on certain status changes
-(either globally or in a specific queue). An example making two custom fields
-mandatory before resolving a ticket in the Helpdesk queue:
+(either globally or in a specific queue) using the C<%MandatoryOnTransition>
+config option. This option takes the generic form of:
+
+ Set( %MandatoryOnTransition,
+ 'QueueName' => {
+ 'from -> to' => [ 'BasicField', 'CF.MyField', ],
+ },
+ );
- Set(%MandatoryOnTransition,
+The fallback for queues without specific rules is specified with C<'*'> where
+the queue name would normally be.
+
+Below is an example which requires 1) time worked and filling in a custom field
+named Resolution before resolving tickets in the Helpdesk queue and 2) a
+Category selection before resolving tickets in every other queue.
+
+ Set( %MandatoryOnTransition,
Helpdesk => {
- '* -> resolved' => ['CF.{Resolution}', 'CF.{Problem area}'],
- });
+ '* -> resolved' => ['TimeWorked', 'CF.Resolution'],
+ },
+ '*' => {
+ '* -> resolved' => 'CF.Category',
+ },
+ );
-The transition syntax is similar to that found in RT's Lifecycles.
+The transition syntax is similar to that found in RT's Lifecycles. See
+C<perldoc /opt/rt4/etc/RT_Config.pm>.
=item Clear your mason cache
@@ -59,6 +127,106 @@ The transition syntax is similar to that found in RT's Lifecycles.
=back
+=head1 IMPLEMENTATION DETAILS
+
+=cut
+
+$RT::Config::META{'MandatoryOnTransition'} = {
+ Type => 'HASH',
+ PostLoadCheck => sub {
+ # Normalize field list to always be arrayref
+ my $self = shift;
+ my %config = $self->Get('MandatoryOnTransition');
+ for my $transitions (values %config) {
+ for (keys %$transitions) {
+ next if ref $transitions->{$_} eq 'ARRAY';
+
+ if (ref $transitions->{$_}) {
+ RT->Logger->error("%MandatoryOnTransition definition '$_' must be a single field name or an array ref of field names. Ignoring.");
+ delete $transitions->{$_};
+ next;
+ }
+
+ $transitions->{$_} = [ $transitions->{$_} ];
+ }
+ }
+ $self->Set(MandatoryOnTransition => %config);
+ },
+};
+
+=head2 RequiredFields
+
+Returns two array refs of required fields for the described status transition.
+The first is core fields, the second is CF names. Returns nothing (C<return;>)
+on error or if nothing is required.
+
+Takes a paramhash with the keys Ticket, Queue, From, and To. Ticket should be
+an object. Queue should be a name. From and To should be statuses. If you
+specify Ticket, only To is otherwise necessary. If you omit Ticket, From, To,
+and Queue are all necessary.
+
+The first transition found in the order below is used:
+
+ from -> to
+ * -> to
+ from -> *
+
+=cut
+
+sub RequiredFields {
+ my $self = shift;
+ my %args = (
+ Ticket => undef,
+ Queue => undef,
+ From => undef,
+ To => undef,
+ @_,
+ );
+
+ if ($args{Ticket}) {
+ $args{Queue} ||= $args{Ticket}->QueueObj->Name;
+ $args{From} ||= $args{Ticket}->Status;
+ }
+ my ($from, $to) = @args{qw(From To)};
+ return unless $from and $to;
+
+ my %config = $self->Config($args{Queue});
+ return unless %config;
+
+ # No transition.
+ return if $from eq $to;
+
+ my $required = $config{"$from -> $to"}
+ || $config{"* -> $to"}
+ || $config{"$from -> *"}
+ || [];
+
+ my @core = grep { !/^CF\./i } @$required;
+ my @cfs = map { /^CF\.(.+)$/i; $1; }
+ grep { /^CF\./i } @$required;
+
+ return (\@core, \@cfs);
+}
+
+=head2 Config
+
+Takes a queue name. Returns a hashref for the given queue (possibly using the
+fallback rules) which contains keys of transitions and values of arrayrefs of
+fields.
+
+You shouldn't need to use this directly.
+
+=cut
+
+sub Config {
+ my $self = shift;
+ my $queue = shift || '*';
+ my %config = RT->Config->Get('MandatoryOnTransition');
+ return %{$config{$queue}} if $config{$queue};
+ return %{$config{'*'}} if $config{'*'};
+ return;
+}
+
=head1 AUTHOR
Thomas Sibley <trs at bestpractical.com>
@@ -69,7 +237,6 @@ All bugs should be reported via
L<http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-MandatoryOnTransition>
or L<bug-RT-Extension-MandatoryOnTransition at rt.cpan.org>.
-
=head1 LICENSE AND COPYRIGHT
This software is Copyright (c) 2012 by Best Practical Solutions
commit 9908f5847a7b148241c7dfcf2b6fd7eeb1509ae7
Author: Thomas Sibley <trs at bestpractical.com>
Date: Mon Jul 23 20:33:01 2012 -0700
Refactor core field lists into lib for use in other components
diff --git a/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate
index 7365052..b2328da 100644
--- a/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate
+++ b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate
@@ -2,7 +2,7 @@
$TicketObj
$ARGSRef
$skip_update
-$results
+$results => []
</%args>
<%init>
my ($core, $cfs) = RT::Extension::MandatoryOnTransition->RequiredFields(
@@ -13,27 +13,15 @@ return unless @$core or @$cfs;
my @errors;
-my @core_allowed = qw(TimeWorked TimeTaken Content);
-my @core_ticket = qw(TimeWorked);
-my %core_for_update = (
- TimeWorked => 'UpdateTimeWorked',
- TimeTaken => 'UpdateTimeWorked',
- Content => 'UpdateContent',
-);
-
# Check core fields, after canonicalization for update
for my $field (@$core) {
- unless (grep { $_ eq $field } @core_allowed) {
- RT->Logger->warning("Skipping unsupported core field '$field' during mandatory checks");
- next;
- }
-
# Will we have a value on update?
- my $arg = $core_for_update{$field} || $field;
+ my $arg = $RT::Extension::MandatoryOnTransition::CORE_FOR_UPDATE{$field} || $field;
next if defined $ARGSRef->{$arg} and length $ARGSRef->{$arg};
# Do we have a value currently?
- next if grep { $_ eq $field } @core_ticket and $TicketObj->$field();
+ next if grep { $_ eq $field } @RT::Extension::MandatoryOnTransition::CORE_TICKET
+ and $TicketObj->$field();
(my $label = $field) =~ s/(?<=[a-z])(?=[A-Z])/ /g; # /
push @errors, loc("[_1] is required when changing Status to [_2]", $label, $ARGSRef->{Status});
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index 32f1176..c6a452c 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -129,6 +129,10 @@ C<perldoc /opt/rt4/etc/RT_Config.pm>.
=head1 IMPLEMENTATION DETAILS
+If you're just using this module on your own RT instance, you should stop
+reading now. You don't need to know about the implementation details unless
+you're writing a patch against this extension.
+
=cut
$RT::Config::META{'MandatoryOnTransition'} = {
@@ -154,10 +158,47 @@ $RT::Config::META{'MandatoryOnTransition'} = {
},
};
-=head2 RequiredFields
+=head2 Package variables
+
+=over 4
+
+=item @CORE_SUPPORTED
+
+The core (basic) fields supported by the extension. Anything else configured
+not in this list is stripped.
+
+=item @CORE_TICKET
+
+The core (basic) fields which should be called as methods on ticket objects to
+check for current values.
+
+=item %CORE_FOR_UPDATE
+
+A mapping which translates core fields into their form input names. For
+example, Content is submitted as UpdateContent.
+
+=back
+
+If you're looking to add support for other core fields, you'll need to push
+into @CORE_SUPPORTED and possibly @CORE_TICKET. You may also need to add a
+pair to %CORE_FOR_UPDATE.
+
+=cut
+
+our @CORE_SUPPORTED = qw(Content TimeWorked TimeTaken);
+our @CORE_TICKET = qw(TimeWorked);
+our %CORE_FOR_UPDATE = (
+ TimeWorked => 'UpdateTimeWorked',
+ TimeTaken => 'UpdateTimeWorked',
+ Content => 'UpdateContent',
+);
+
+=head2 Methods
+
+=head3 RequiredFields
Returns two array refs of required fields for the described status transition.
-The first is core fields, the second is CF names. Returns nothing (C<return;>)
+The first is core fields, the second is CF names. Returns empty array refs
on error or if nothing is required.
Takes a paramhash with the keys Ticket, Queue, From, and To. Ticket should be
@@ -188,27 +229,29 @@ sub RequiredFields {
$args{From} ||= $args{Ticket}->Status;
}
my ($from, $to) = @args{qw(From To)};
- return unless $from and $to;
+ return ([], []) unless $from and $to;
my %config = $self->Config($args{Queue});
- return unless %config;
+ return ([], []) unless %config;
# No transition.
- return if $from eq $to;
+ return ([], []) if $from eq $to;
my $required = $config{"$from -> $to"}
|| $config{"* -> $to"}
|| $config{"$from -> *"}
|| [];
- my @core = grep { !/^CF\./i } @$required;
+ my %core_supported = map { $_ => 1 } @CORE_SUPPORTED;
+
+ my @core = grep { !/^CF\./i && $core_supported{$_} } @$required;
my @cfs = map { /^CF\.(.+)$/i; $1; }
grep { /^CF\./i } @$required;
return (\@core, \@cfs);
}
-=head2 Config
+=head3 Config
Takes a queue name. Returns a hashref for the given queue (possibly using the
fallback rules) which contains keys of transitions and values of arrayrefs of
commit 008d0c3645187322193d76854309b52658667bba
Author: Thomas Sibley <trs at bestpractical.com>
Date: Mon Jul 23 20:40:09 2012 -0700
Add a MANIFEST
diff --git a/MANIFEST b/MANIFEST
new file mode 100644
index 0000000..6126376
--- /dev/null
+++ b/MANIFEST
@@ -0,0 +1,18 @@
+html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Elements/EditCustomFields/MassageCustomFields
+html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/AfterWorked
+html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate
+inc/Module/Install.pm
+inc/Module/Install/Base.pm
+inc/Module/Install/Can.pm
+inc/Module/Install/Fetch.pm
+inc/Module/Install/Makefile.pm
+inc/Module/Install/Metadata.pm
+inc/Module/Install/ReadmeFromPod.pm
+inc/Module/Install/RTx.pm
+inc/Module/Install/Win32.pm
+inc/Module/Install/WriteAll.pm
+lib/RT/Extension/MandatoryOnTransition.pm
+Makefile.PL
+MANIFEST This list of files
+META.yml
+README
diff --git a/MANIFEST.SKIP b/MANIFEST.SKIP
new file mode 100644
index 0000000..6ab20d3
--- /dev/null
+++ b/MANIFEST.SKIP
@@ -0,0 +1,42 @@
+
+#!start included /opt/local/lib/perl5/5.8.9/ExtUtils/MANIFEST.SKIP
+# Avoid version control files.
+\bRCS\b
+\bCVS\b
+\bSCCS\b
+,v$
+\B\.svn\b
+\B\.git\b
+\B\.gitignore\b
+\b_darcs\b
+
+# Avoid Makemaker generated and utility files.
+\bMANIFEST\.bak
+\bMakefile$
+\bblib/
+\bMakeMaker-\d
+\bpm_to_blib\.ts$
+\bpm_to_blib$
+\bblibdirs\.ts$ # 6.18 through 6.25 generated this
+
+# Avoid Module::Build generated and utility files.
+\bBuild$
+\b_build/
+
+# Avoid temp and backup files.
+~$
+\.old$
+\#$
+\b\.#
+\.bak$
+\.swp$
+
+# Avoid Devel::Cover files.
+\bcover_db\b
+#!end included /opt/local/lib/perl5/5.8.9/ExtUtils/MANIFEST.SKIP
+
+t/tmp/
+\.tagstagstags
+MYMETA\.json
+MYMETA\.yml$
+\.tar\.gz$$
commit 48e8b2773758c425b9670fec0903206b29a2b99b
Author: Thomas Sibley <trs at bestpractical.com>
Date: Mon Jul 23 20:40:30 2012 -0700
Add Module::Install
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
new file mode 100644
index 0000000..4ecf46b
--- /dev/null
+++ b/inc/Module/Install.pm
@@ -0,0 +1,470 @@
+#line 1
+package Module::Install;
+
+# For any maintainers:
+# The load order for Module::Install is a bit magic.
+# It goes something like this...
+#
+# IF ( host has Module::Install installed, creating author mode ) {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to installed version of inc::Module::Install
+# 3. The installed version of inc::Module::Install loads
+# 4. inc::Module::Install calls "require Module::Install"
+# 5. The ./inc/ version of Module::Install loads
+# } ELSE {
+# 1. Makefile.PL calls "use inc::Module::Install"
+# 2. $INC{inc/Module/Install.pm} set to ./inc/ version of Module::Install
+# 3. The ./inc/ version of Module::Install loads
+# }
+
+use 5.005;
+use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
+
+use vars qw{$VERSION $MAIN};
+BEGIN {
+ # All Module::Install core packages now require synchronised versions.
+ # This will be used to ensure we don't accidentally load old or
+ # different versions of modules.
+ # 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.06';
+
+ # Storage for the pseudo-singleton
+ $MAIN = undef;
+
+ *inc::Module::Install::VERSION = *VERSION;
+ @inc::Module::Install::ISA = __PACKAGE__;
+
+}
+
+sub import {
+ my $class = shift;
+ my $self = $class->new(@_);
+ my $who = $self->_caller;
+
+ #-------------------------------------------------------------
+ # 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:
+
+ use inc::${\__PACKAGE__};
+
+not:
+
+ use ${\__PACKAGE__};
+
+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).
+
+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" }
+
+Module::Install no longer supports Build.PL.
+
+It was impossible to maintain duel backends, and has been deprecated.
+
+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/;
+ }
+
+ 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;
+
+ return 1;
+}
+
+sub autoload {
+ my $self = shift;
+ my $who = $self->_caller;
+ my $cwd = Cwd::cwd();
+ my $sym = "${who}::AUTOLOAD";
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::cwd();
+ if ( my $code = $sym->{$pwd} ) {
+ # Delegate back to parent dirs
+ goto &$code unless $cwd eq $pwd;
+ }
+ unless ($$sym =~ s/([^:]+)$//) {
+ # XXX: it looks like we can't retrieve the missing function
+ # via $$sym (usually $main::AUTOLOAD) in this case.
+ # I'm still wondering if we should slurp Makefile.PL to
+ # get some context or not ...
+ my ($package, $file, $line) = caller;
+ die <<"EOT";
+Unknown function is found at $file line $line.
+Execution of $file aborted due to runtime errors.
+
+If you're a contributor to a project, you may need to install
+some Module::Install extensions from CPAN (or other repository).
+If you're a user of a module, please contact the author.
+EOT
+ }
+ my $method = $1;
+ if ( uc($method) eq $method ) {
+ # Do nothing
+ return;
+ } elsif ( $method =~ /^_/ and $self->can($method) ) {
+ # Dispatch to the root M:I class
+ return $self->$method(@_);
+ }
+
+ # Dispatch to the appropriate plugin
+ unshift @_, ( $self, $1 );
+ goto &{$self->can('call')};
+ };
+}
+
+sub preload {
+ my $self = shift;
+ unless ( $self->{extensions} ) {
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ );
+ }
+
+ my @exts = @{$self->{extensions}};
+ unless ( @exts ) {
+ @exts = $self->{admin}->load_all_extensions;
+ }
+
+ my %seen;
+ foreach my $obj ( @exts ) {
+ while (my ($method, $glob) = each %{ref($obj) . '::'}) {
+ next unless $obj->can($method);
+ next if $method =~ /^_/;
+ next if $method eq uc($method);
+ $seen{$method}++;
+ }
+ }
+
+ my $who = $self->_caller;
+ foreach my $name ( sort keys %seen ) {
+ local $^W;
+ *{"${who}::$name"} = sub {
+ ${"${who}::AUTOLOAD"} = "${who}::$name";
+ goto &{"${who}::AUTOLOAD"};
+ };
+ }
+}
+
+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';
+ $args{prefix} ||= 'inc';
+ $args{author} ||= ($^O eq 'VMS' ? '_author' : '.author');
+ $args{bundle} ||= 'inc/BUNDLES';
+ $args{base} ||= $base_path;
+ $class =~ s/^\Q$args{prefix}\E:://;
+ $args{name} ||= $class;
+ $args{version} ||= $class->VERSION;
+ unless ( $args{path} ) {
+ $args{path} = $args{name};
+ $args{path} =~ s!::!/!g;
+ }
+ $args{file} ||= "$args{base}/$args{prefix}/$args{path}.pm";
+ $args{wrote} = 0;
+
+ bless( \%args, $class );
+}
+
+sub call {
+ my ($self, $method) = @_;
+ my $obj = $self->load($method) or return;
+ splice(@_, 0, 2, $obj);
+ goto &{$obj->can($method)};
+}
+
+sub load {
+ my ($self, $method) = @_;
+
+ $self->load_extensions(
+ "$self->{prefix}/$self->{path}", $self
+ ) unless $self->{extensions};
+
+ foreach my $obj (@{$self->{extensions}}) {
+ return $obj if $obj->can($method);
+ }
+
+ my $admin = $self->{admin} or die <<"END_DIE";
+The '$method' method does not exist in the '$self->{prefix}' path!
+Please remove the '$self->{prefix}' directory and run $0 again to load it.
+END_DIE
+
+ my $obj = $admin->load($method, 1);
+ push @{$self->{extensions}}, $obj;
+
+ $obj;
+}
+
+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) ) {
+ my ($file, $pkg) = @{$rv};
+ next if $self->{pathnames}{$pkg};
+
+ local $@;
+ my $new = eval { local $^W; require $file; $pkg->can('new') };
+ unless ( $new ) {
+ warn $@ if $@;
+ next;
+ }
+ $self->{pathnames}{$pkg} =
+ $should_reload ? delete $INC{$file} : $INC{$file};
+ push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
+ }
+
+ $self->{extensions} ||= [];
+}
+
+sub find_extensions {
+ my ($self, $path) = @_;
+
+ my @found;
+ File::Find::find( sub {
+ my $file = $File::Find::name;
+ return unless $file =~ m!^\Q$path\E/(.+)\.pm\Z!is;
+ my $subpath = $1;
+ return if lc($subpath) eq lc($self->{dispatch});
+
+ $file = "$self->{path}/$subpath.pm";
+ my $pkg = "$self->{name}::$subpath";
+ $pkg =~ s!/!::!g;
+
+ # If we have a mixed-case package name, assume case has been preserved
+ # correctly. Otherwise, root through the file to locate the case-preserved
+ # version of the package name.
+ if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
+ my $content = Module::Install::_read($subpath . '.pm');
+ my $in_pod = 0;
+ foreach ( split //, $content ) {
+ $in_pod = 1 if /^=\w/;
+ $in_pod = 0 if /^=cut/;
+ next if ($in_pod || /^=cut/); # skip pod text
+ next if /^\s*#/; # and comments
+ if ( m/^\s*package\s+($pkg)\s*;/i ) {
+ $pkg = $1;
+ last;
+ }
+ }
+ }
+
+ push @found, [ $file, $pkg ];
+ }, $path ) if -d $path;
+
+ @found;
+}
+
+
+
+
+
+#####################################################################
+# Common Utility Functions
+
+sub _caller {
+ my $depth = 0;
+ my $call = caller($depth);
+ while ( $call eq __PACKAGE__ ) {
+ $depth++;
+ $call = caller($depth);
+ }
+ return $call;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _read {
+ local *FH;
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_NEW
+sub _read {
+ local *FH;
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ my $string = do { local $/; <FH> };
+ close FH or die "close($_[0]): $!";
+ return $string;
+}
+END_OLD
+
+sub _readperl {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ $string =~ s/(\n)\n*__(?:DATA|END)__\b.*\z/$1/s;
+ $string =~ s/\n\n=\w+.+?\n\n=cut\b.+?\n+/\n\n/sg;
+ return $string;
+}
+
+sub _readpod {
+ my $string = Module::Install::_read($_[0]);
+ $string =~ s/(?:\015{1,2}\012|\015|\012)/\n/sg;
+ return $string if $_[0] =~ /\.pod\z/;
+ $string =~ s/(^|\n=cut\b.+?\n+)[^=\s].+?\n(\n=\w+|\z)/$1$2/sg;
+ $string =~ s/\n*=pod\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/\n*=cut\b[^\n]*\n+/\n\n/sg;
+ $string =~ s/^\n+//s;
+ return $string;
+}
+
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _write {
+ local *FH;
+ open( FH, '>', $_[0] ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_NEW
+sub _write {
+ local *FH;
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
+ close FH or die "close($_[0]): $!";
+}
+END_OLD
+
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version ($) {
+ my $s = shift || 0;
+ my $d =()= $s =~ /(\.)/g;
+ if ( $d >= 2 ) {
+ # Normalise multipart versions
+ $s =~ s/(\.)(\d{1,3})/sprintf("$1%03d",$2)/eg;
+ }
+ $s =~ s/^(\d+)\.?//;
+ my $l = $1 || 0;
+ my @v = map {
+ $_ . '0' x (3 - length $_)
+ } $s =~ /(\d{1,3})\D?/g;
+ $l = $l . '.' . join '', @v if @v;
+ return $l + 0;
+}
+
+sub _cmp ($$) {
+ _version($_[1]) <=> _version($_[2]);
+}
+
+# Cloned from Params::Util::_CLASS
+sub _CLASS ($) {
+ (
+ defined $_[0]
+ and
+ ! ref $_[0]
+ and
+ $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
+ ) ? $_[0] : undef;
+}
+
+1;
+
+# Copyright 2008 - 2012 Adam Kennedy.
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
new file mode 100644
index 0000000..802844a
--- /dev/null
+++ b/inc/Module/Install/Base.pm
@@ -0,0 +1,83 @@
+#line 1
+package Module::Install::Base;
+
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.06';
+}
+
+# Suspend handler for "redefined" warnings
+BEGIN {
+ my $w = $SIG{__WARN__};
+ $SIG{__WARN__} = sub { $w };
+}
+
+#line 42
+
+sub new {
+ my $class = shift;
+ unless ( defined &{"${class}::call"} ) {
+ *{"${class}::call"} = sub { shift->_top->call(@_) };
+ }
+ unless ( defined &{"${class}::load"} ) {
+ *{"${class}::load"} = sub { shift->_top->load(@_) };
+ }
+ bless { @_ }, $class;
+}
+
+#line 61
+
+sub AUTOLOAD {
+ local $@;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
+}
+
+#line 75
+
+sub _top {
+ $_[0]->{_top};
+}
+
+#line 90
+
+sub admin {
+ $_[0]->_top->{admin}
+ or
+ Module::Install::Base::FakeAdmin->new;
+}
+
+#line 106
+
+sub is_admin {
+ ! $_[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 {
+ $fake ||= bless(\@_, $_[0]);
+}
+
+sub AUTOLOAD {}
+
+sub DESTROY {}
+
+# Restore warning handler
+BEGIN {
+ $SIG{__WARN__} = $SIG{__WARN__}->();
+}
+
+1;
+
+#line 159
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
new file mode 100644
index 0000000..22167b8
--- /dev/null
+++ b/inc/Module/Install/Can.pm
@@ -0,0 +1,154 @@
+#line 1
+package Module::Install::Can;
+
+use strict;
+use Config ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# check if we can load some module
+### Upgrade this to not have to load the module if possible
+sub can_use {
+ my ($self, $mod, $ver) = @_;
+ $mod =~ s{::|\\}{/}g;
+ $mod .= '.pm' unless $mod =~ /\.pm$/i;
+
+ my $pkg = $mod;
+ $pkg =~ s{/}{::}g;
+ $pkg =~ s{\.pm$}{}i;
+
+ local $@;
+ eval { require $mod; $pkg->VERSION($ver || 0); 1 };
+}
+
+# Check if we can run some command
+sub can_run {
+ my ($self, $cmd) = @_;
+
+ my $_cmd = $cmd;
+ return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
+
+ for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
+ next if $dir eq '';
+ require File::Spec;
+ my $abs = File::Spec->catfile($dir, $cmd);
+ return $abs if (-x $abs or $abs = MM->maybe_command($abs));
+ }
+
+ return;
+}
+
+# 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;
+
+ # $Config{cc} may contain args; try to find out the program part
+ while (@chunks) {
+ return $self->can_run("@chunks") || (pop(@chunks), next);
+ }
+
+ return;
+}
+
+# Fix Cygwin bug on maybe_command();
+if ( $^O eq 'cygwin' ) {
+ require ExtUtils::MM_Cygwin;
+ require ExtUtils::MM_Win32;
+ if ( ! defined(&ExtUtils::MM_Cygwin::maybe_command) ) {
+ *ExtUtils::MM_Cygwin::maybe_command = sub {
+ my ($self, $file) = @_;
+ if ($file =~ m{^/cygdrive/}i and ExtUtils::MM_Win32->can('maybe_command')) {
+ ExtUtils::MM_Win32->maybe_command($file);
+ } else {
+ ExtUtils::MM_Unix->maybe_command($file);
+ }
+ }
+ }
+}
+
+1;
+
+__END__
+
+#line 236
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
new file mode 100644
index 0000000..bee0c4f
--- /dev/null
+++ b/inc/Module/Install/Fetch.pm
@@ -0,0 +1,93 @@
+#line 1
+package Module::Install::Fetch;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub get_file {
+ my ($self, %args) = @_;
+ my ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+
+ if ( $scheme eq 'http' and ! eval { require LWP::Simple; 1 } ) {
+ $args{url} = $args{ftp_url}
+ or (warn("LWP support unavailable!\n"), return);
+ ($scheme, $host, $path, $file) =
+ $args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
+ }
+
+ $|++;
+ print "Fetching '$file' from $host... ";
+
+ unless (eval { require Socket; Socket::inet_aton($host) }) {
+ warn "'$host' resolve failed!\n";
+ return;
+ }
+
+ return unless $scheme eq 'ftp' or $scheme eq 'http';
+
+ require Cwd;
+ my $dir = Cwd::getcwd();
+ chdir $args{local_dir} or return if exists $args{local_dir};
+
+ if (eval { require LWP::Simple; 1 }) {
+ LWP::Simple::mirror($args{url}, $file);
+ }
+ elsif (eval { require Net::FTP; 1 }) { eval {
+ # use Net::FTP to get past firewall
+ my $ftp = Net::FTP->new($host, Passive => 1, Timeout => 600);
+ $ftp->login("anonymous", 'anonymous at example.com');
+ $ftp->cwd($path);
+ $ftp->binary;
+ $ftp->get($file) or (warn("$!\n"), return);
+ $ftp->quit;
+ } }
+ elsif (my $ftp = $self->can_run('ftp')) { eval {
+ # no Net::FTP, fallback to ftp.exe
+ require FileHandle;
+ my $fh = FileHandle->new;
+
+ local $SIG{CHLD} = 'IGNORE';
+ unless ($fh->open("|$ftp -n")) {
+ warn "Couldn't open ftp: $!\n";
+ chdir $dir; return;
+ }
+
+ my @dialog = split(/\n/, <<"END_FTP");
+open $host
+user anonymous anonymous\@example.com
+cd $path
+binary
+get $file $file
+quit
+END_FTP
+ foreach (@dialog) { $fh->print("$_\n") }
+ $fh->close;
+ } }
+ else {
+ warn "No working 'ftp' program available!\n";
+ chdir $dir; return;
+ }
+
+ unless (-f $file) {
+ warn "Fetching failed: $@\n";
+ chdir $dir; return;
+ }
+
+ return if exists $args{size} and -s $file != $args{size};
+ system($args{run}) if exists $args{run};
+ unlink($file) if $args{remove};
+
+ print(((!exists $args{check_for} or -e $args{check_for})
+ ? "done!" : "failed! ($!)"), "\n");
+ chdir $dir; return !$?;
+}
+
+1;
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
new file mode 100644
index 0000000..7052f36
--- /dev/null
+++ b/inc/Module/Install/Makefile.pm
@@ -0,0 +1,418 @@
+#line 1
+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 = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub Makefile { $_[0] }
+
+my %seen = ();
+
+sub prompt {
+ shift;
+
+ # Infinite loop protection
+ my @c = caller();
+ if ( ++$seen{"$c[1]|$c[2]|$_[0]"} > 3 ) {
+ die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
+ }
+
+ # 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 {
+ goto &ExtUtils::MakeMaker::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, %new_args) = @_;
+ my $args = ( $self->{makemaker_args} ||= {} );
+ foreach my $key (keys %new_args) {
+ if ($makemaker_argtype{$key}) {
+ if ($makemaker_argtype{$key} eq 'ARRAY') {
+ $args->{$key} = [] unless defined $args->{$key};
+ unless (ref $args->{$key} eq 'ARRAY') {
+ $args->{$key} = [$args->{$key}]
+ }
+ push @{$args->{$key}},
+ ref $new_args{$key} eq 'ARRAY'
+ ? @{$new_args{$key}}
+ : $new_args{$key};
+ }
+ elsif ($makemaker_argtype{$key} eq 'HASH') {
+ $args->{$key} = {} unless defined $args->{$key};
+ foreach my $skey (keys %{ $new_args{$key} }) {
+ $args->{$key}{$skey} = $new_args{$key}{$skey};
+ }
+ }
+ elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+ $self->makemaker_append($key => $new_args{$key});
+ }
+ }
+ else {
+ if (defined $args->{$key}) {
+ warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+ }
+ $args->{$key} = $new_args{$key};
+ }
+ }
+ return $args;
+}
+
+# For mm args that take multiple space-seperated args,
+# append an argument to the current list.
+sub makemaker_append {
+ my $self = shift;
+ my $name = shift;
+ my $args = $self->makemaker_args;
+ $args->{$name} = defined $args->{$name}
+ ? join( ' ', $args->{$name}, @_ )
+ : join( ' ', @_ );
+}
+
+sub build_subdirs {
+ my $self = shift;
+ my $subdirs = $self->makemaker_args->{DIR} ||= [];
+ for my $subdir (@_) {
+ push @$subdirs, $subdir;
+ }
+}
+
+sub clean_files {
+ my $self = shift;
+ my $clean = $self->makemaker_args->{clean} ||= {};
+ %$clean = (
+ %$clean,
+ FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
+ );
+}
+
+sub realclean_files {
+ my $self = shift;
+ my $realclean = $self->makemaker_args->{realclean} ||= {};
+ %$realclean = (
+ %$realclean,
+ FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
+ );
+}
+
+sub libs {
+ my $self = shift;
+ my $libs = ref $_[0] ? shift : [ shift ];
+ $self->makemaker_args( LIBS => $libs );
+}
+
+sub inc {
+ my $self = shift;
+ $self->makemaker_args( INC => shift );
+}
+
+sub _wanted_t {
+}
+
+sub tests_recursive {
+ my $self = shift;
+ my $dir = shift || 't';
+ unless ( -d $dir ) {
+ die "tests_recursive dir '$dir' does not exist";
+ }
+ my %tests = map { $_ => 1 } split / /, ($self->tests || '');
+ require File::Find;
+ File::Find::find(
+ sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
+ $dir
+ );
+ $self->tests( join ' ', sort keys %tests );
+}
+
+sub write {
+ my $self = shift;
+ die "&Makefile->write() takes no arguments\n" if @_;
+
+ # Check the current Perl version
+ my $perl_version = $self->perl_version;
+ if ( $perl_version ) {
+ eval "use $perl_version; 1"
+ or die "ERROR: perl: Version $] is installed, "
+ . "but we need version >= $perl_version";
+ }
+
+ # Make sure we have a new enough MakeMaker
+ require ExtUtils::MakeMaker;
+
+ if ( $perl_version and $self->_cmp($perl_version, '5.006') >= 0 ) {
+ # 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.36 );
+ $self->configure_requires( 'ExtUtils::MakeMaker' => 6.36 );
+ }
+
+ # Generate the MakeMaker params
+ my $args = $self->makemaker_args;
+ $args->{DISTNAME} = $self->name;
+ $args->{NAME} = $self->module_name || $self->name;
+ $args->{NAME} =~ s/-/::/g;
+ $args->{VERSION} = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+in a module, and provide its file path via 'version_from' (or
+'all_from' if you prefer) in Makefile.PL.
+EOT
+
+ if ( $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} = join ', ', @{$self->author || []};
+ }
+ if ( $self->makemaker(6.10) ) {
+ $args->{NO_META} = 1;
+ #$args->{NO_MYMETA} = 1;
+ }
+ 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;
+ }
+
+ my $prereq = ($args->{PREREQ_PM} ||= {});
+ %$prereq = ( %$prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->requires)
+ );
+
+ # Remove any reference to perl, PREREQ_PM doesn't support it
+ delete $args->{PREREQ_PM}->{perl};
+
+ # 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 ($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;
+ }
+ }
+
+ 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 $user_preop = delete $args{dist}->{PREOP};
+ if ( my $preop = $self->admin->preop($user_preop) ) {
+ foreach my $key ( keys %$preop ) {
+ $args{dist}->{$key} = $preop->{$key};
+ }
+ }
+
+ my $mm = ExtUtils::MakeMaker::WriteMakefile(%args);
+ $self->fix_up_makefile($mm->{FIRST_MAKEFILE} || 'Makefile');
+}
+
+sub fix_up_makefile {
+ my $self = shift;
+ my $makefile_name = shift;
+ my $top_class = ref($self->_top) || '';
+ my $top_version = $self->_top->VERSION || '';
+
+ my $preamble = $self->preamble
+ ? "# Preamble by $top_class $top_version\n"
+ . $self->preamble
+ : '';
+ my $postamble = "# Postamble by $top_class $top_version\n"
+ . ($self->postamble || '');
+
+ local *MAKEFILE;
+ open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ eval { flock MAKEFILE, LOCK_EX };
+ my $makefile = do { local $/; <MAKEFILE> };
+
+ $makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
+ $makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
+ $makefile =~ s/( "-I\$\(INST_LIB\)")/ "-Iinc"$1/g;
+ $makefile =~ s/^(FULLPERL = .*)/$1 "-Iinc"/m;
+ $makefile =~ s/^(PERL = .*)/$1 "-Iinc"/m;
+
+ # Module::Install will never be used to build the Core Perl
+ # Sometimes PERL_LIB and PERL_ARCHLIB get written anyway, which breaks
+ # PREFIX/PERL5LIB, and thus, install_share. Blank them if they exist
+ $makefile =~ s/^PERL_LIB = .+/PERL_LIB =/m;
+ #$makefile =~ s/^PERL_ARCHLIB = .+/PERL_ARCHLIB =/m;
+
+ # Perl 5.005 mentions PERL_LIB explicitly, so we have to remove that as well.
+ $makefile =~ s/(\"?)-I\$\(PERL_LIB\)\1//g;
+
+ # XXX - This is currently unused; not sure if it breaks other MM-users
+ # $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
+
+ seek MAKEFILE, 0, SEEK_SET;
+ truncate MAKEFILE, 0;
+ print MAKEFILE "$preamble$makefile$postamble" or die $!;
+ close MAKEFILE or die $!;
+
+ 1;
+}
+
+sub preamble {
+ my ($self, $text) = @_;
+ $self->{preamble} = $text . $self->{preamble} if defined $text;
+ $self->{preamble};
+}
+
+sub postamble {
+ my ($self, $text) = @_;
+ $self->{postamble} ||= $self->admin->postamble;
+ $self->{postamble} .= $text if defined $text;
+ $self->{postamble}
+}
+
+1;
+
+__END__
+
+#line 544
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
new file mode 100644
index 0000000..58430f3
--- /dev/null
+++ b/inc/Module/Install/Metadata.pm
@@ -0,0 +1,722 @@
+#line 1
+package Module::Install::Metadata;
+
+use strict 'vars';
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+my @boolean_keys = qw{
+ sign
+};
+
+my @scalar_keys = qw{
+ name
+ module_name
+ abstract
+ version
+ distribution_type
+ tests
+ installdirs
+};
+
+my @tuple_keys = qw{
+ configure_requires
+ build_requires
+ requires
+ recommends
+ bundles
+ resources
+};
+
+my @resource_keys = qw{
+ homepage
+ bugtracker
+ repository
+};
+
+my @array_keys = qw{
+ keywords
+ author
+};
+
+*authors = \&author;
+
+sub Meta { shift }
+sub Meta_BooleanKeys { @boolean_keys }
+sub Meta_ScalarKeys { @scalar_keys }
+sub Meta_TupleKeys { @tuple_keys }
+sub Meta_ResourceKeys { @resource_keys }
+sub Meta_ArrayKeys { @array_keys }
+
+foreach my $key ( @boolean_keys ) {
+ *$key = sub {
+ my $self = shift;
+ if ( defined wantarray and not @_ ) {
+ return $self->{values}->{$key};
+ }
+ $self->{values}->{$key} = ( @_ ? $_[0] : 1 );
+ return $self;
+ };
+}
+
+foreach my $key ( @scalar_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} = shift;
+ return $self;
+ };
+}
+
+foreach my $key ( @array_keys ) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} if defined wantarray and !@_;
+ $self->{values}->{$key} ||= [];
+ push @{$self->{values}->{$key}}, @_;
+ return $self;
+ };
+}
+
+foreach my $key ( @resource_keys ) {
+ *$key = sub {
+ my $self = shift;
+ unless ( @_ ) {
+ return () unless $self->{values}->{resources};
+ return map { $_->[1] }
+ grep { $_->[0] eq $key }
+ @{ $self->{values}->{resources} };
+ }
+ return $self->{values}->{resources}->{$key} unless @_;
+ my $uri = shift or die(
+ "Did not provide a value to $key()"
+ );
+ $self->resources( $key => $uri );
+ return 1;
+ };
+}
+
+foreach my $key ( grep { $_ ne "resources" } @tuple_keys) {
+ *$key = sub {
+ my $self = shift;
+ return $self->{values}->{$key} unless @_;
+ my @added;
+ while ( @_ ) {
+ my $module = shift or last;
+ my $version = shift || 0;
+ push @added, [ $module, $version ];
+ }
+ push @{ $self->{values}->{$key} }, @added;
+ return map {@$_} @added;
+ };
+}
+
+# Resource handling
+my %lc_resource = map { $_ => 1 } qw{
+ homepage
+ license
+ bugtracker
+ repository
+};
+
+sub resources {
+ my $self = shift;
+ while ( @_ ) {
+ my $name = shift or last;
+ my $value = shift or next;
+ if ( $name eq lc $name and ! $lc_resource{$name} ) {
+ die("Unsupported reserved lowercase resource '$name'");
+ }
+ $self->{values}->{resources} ||= [];
+ push @{ $self->{values}->{resources} }, [ $name, $value ];
+ }
+ $self->{values}->{resources};
+}
+
+# Aliases for build_requires that will have alternative
+# meanings in some future version of META.yml.
+sub test_requires { shift->build_requires(@_) }
+sub install_requires { shift->build_requires(@_) }
+
+# Aliases for installdirs options
+sub install_as_core { $_[0]->installdirs('perl') }
+sub install_as_cpan { $_[0]->installdirs('site') }
+sub install_as_site { $_[0]->installdirs('site') }
+sub install_as_vendor { $_[0]->installdirs('vendor') }
+
+sub dynamic_config {
+ 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} = $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 @_;
+ my $version = shift or die(
+ "Did not provide a value to perl_version()"
+ );
+
+ # Normalize the version
+ $version = $self->_perl_version($version);
+
+ # We don't support the really old versions
+ unless ( $version >= 5.005 ) {
+ die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
+ }
+
+ $self->{values}->{perl_version} = $version;
+}
+
+sub all_from {
+ my ( $self, $file ) = @_;
+
+ unless ( defined($file) ) {
+ my $name = $self->name or die(
+ "all_from called with no args without setting name() first"
+ );
+ $file = join('/', 'lib', split(/-/, $name)) . '.pm';
+ $file =~ s{.*/}{} unless -e $file;
+ unless ( -e $file ) {
+ die("all_from cannot find $file from $name");
+ }
+ }
+ unless ( -f $file ) {
+ die("The path '$file' does not exist, or is not a file");
+ }
+
+ $self->{values}{all_from} = $file;
+
+ # Some methods pull from POD instead of code.
+ # If there is a matching .pod, use that instead
+ my $pod = $file;
+ $pod =~ s/\.pm$/.pod/i;
+ $pod = $file unless -e $pod;
+
+ # Pull the different values
+ $self->name_from($file) unless $self->name;
+ $self->version_from($file) unless $self->version;
+ $self->perl_version_from($file) unless $self->perl_version;
+ $self->author_from($pod) unless @{$self->author || []};
+ $self->license_from($pod) unless $self->license;
+ $self->abstract_from($pod) unless $self->abstract;
+
+ return 1;
+}
+
+sub provides {
+ my $self = shift;
+ my $provides = ( $self->{values}->{provides} ||= {} );
+ %$provides = (%$provides, @_) if @_;
+ return $provides;
+}
+
+sub auto_provides {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ unless (-e 'MANIFEST') {
+ warn "Cannot deduce auto_provides without a MANIFEST, skipping\n";
+ return $self;
+ }
+ # Avoid spurious warnings as we are not checking manifest here.
+ local $SIG{__WARN__} = sub {1};
+ require ExtUtils::Manifest;
+ local *ExtUtils::Manifest::manicheck = sub { return };
+
+ require Module::Build;
+ my $build = Module::Build->new(
+ dist_name => $self->name,
+ dist_version => $self->version,
+ license => $self->license,
+ );
+ $self->provides( %{ $build->find_dist_packages || {} } );
+}
+
+sub feature {
+ my $self = shift;
+ my $name = shift;
+ my $features = ( $self->{values}->{features} ||= [] );
+ my $mods;
+
+ if ( @_ == 1 and ref( $_[0] ) ) {
+ # The user used ->feature like ->features by passing in the second
+ # argument as a reference. Accomodate for that.
+ $mods = $_[0];
+ } else {
+ $mods = \@_;
+ }
+
+ my $count = 0;
+ push @$features, (
+ $name => [
+ map {
+ ref($_) ? ( ref($_) eq 'HASH' ) ? %$_ : @$_ : $_
+ } @$mods
+ ]
+ );
+
+ return @$features;
+}
+
+sub features {
+ my $self = shift;
+ while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
+ $self->feature( $name, @$mods );
+ }
+ return $self->{values}->{features}
+ ? @{ $self->{values}->{features} }
+ : ();
+}
+
+sub no_index {
+ my $self = shift;
+ my $type = shift;
+ push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
+ return $self->{values}->{no_index};
+}
+
+sub read {
+ my $self = shift;
+ $self->include_deps( 'YAML::Tiny', 0 );
+
+ require YAML::Tiny;
+ my $data = YAML::Tiny::LoadFile('META.yml');
+
+ # Call methods explicitly in case user has already set some values.
+ while ( my ( $key, $value ) = each %$data ) {
+ next unless $self->can($key);
+ if ( ref $value eq 'HASH' ) {
+ while ( my ( $module, $version ) = each %$value ) {
+ $self->can($key)->($self, $module => $version );
+ }
+ } else {
+ $self->can($key)->($self, $value);
+ }
+ }
+ return $self;
+}
+
+sub write {
+ my $self = shift;
+ return $self unless $self->is_admin;
+ $self->admin->write_meta;
+ return $self;
+}
+
+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 {
+ require ExtUtils::MM_Unix;
+ my ( $self, $file ) = @_;
+ $self->abstract(
+ bless(
+ { DISTNAME => $self->name },
+ 'ExtUtils::MM_Unix'
+ )->parse_abstract($file)
+ );
+}
+
+# Add both distribution and module name
+sub name_from {
+ my ($self, $file) = @_;
+ if (
+ Module::Install::_read($file) =~ m/
+ ^ \s*
+ package \s*
+ ([\w:]+)
+ \s* ;
+ /ixms
+ ) {
+ my ($name, $module_name) = ($1, $1);
+ $name =~ s{::}{-}g;
+ $self->name($name);
+ unless ( $self->module_name ) {
+ $self->module_name($module_name);
+ }
+ } else {
+ die("Cannot determine name from $file\n");
+ }
+}
+
+sub _extract_perl_version {
+ if (
+ $_[0] =~ m/
+ ^\s*
+ (?:use|require) \s*
+ v?
+ ([\d_\.]+)
+ \s* ;
+ /ixms
+ ) {
+ 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";
+ return;
+ }
+}
+
+sub author_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ if ($content =~ m/
+ =head \d \s+ (?:authors?)\b \s*
+ ([^\n]*)
+ |
+ =head \d \s+ (?:licen[cs]e|licensing|copyright|legal)\b \s*
+ .*? copyright .*? \d\d\d[\d.]+ \s* (?:\bby\b)? \s*
+ ([^\n]*)
+ /ixms) {
+ my $author = $1 || $2;
+
+ # 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";
+ }
+}
+
+#Stolen from M::B
+my %license_urls = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
+ gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+);
+
+sub license {
+ my $self = shift;
+ return $self->{values}->{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $license = __extract_license($license) || lc $license;
+ $self->{values}->{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license_urls{$license} ) {
+ $self->resources( license => $license_urls{$license} );
+ }
+
+ return 1;
+}
+
+sub _extract_license {
+ my $pod = shift;
+ my $matched;
+ return __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ ) || __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ );
+}
+
+sub __extract_license {
+ my $license_text = shift or return;
+ my @phrases = (
+ '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
+ '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'Artistic and GPL' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'GNU Free Documentation license' => 'unrestricted', 1,
+ 'GNU Affero General Public License' => 'open_source', 1,
+ '(?:Free)?BSD license' => 'bsd', 1,
+ 'Artistic license 2\.0' => 'artistic_2', 1,
+ 'Artistic license' => 'artistic', 1,
+ 'Apache (?:Software )?license' => 'apache', 1,
+ 'GPL' => 'gpl', 1,
+ 'LGPL' => 'lgpl', 1,
+ 'BSD' => 'bsd', 1,
+ 'Artistic' => 'artistic', 1,
+ 'MIT' => 'mit', 1,
+ 'Mozilla Public License' => 'mozilla', 1,
+ 'Q Public License' => 'open_source', 1,
+ 'OpenSSL License' => 'unrestricted', 1,
+ 'SSLeay License' => 'unrestricted', 1,
+ 'zlib License' => 'open_source', 1,
+ 'proprietary' => 'proprietary', 0,
+ );
+ while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
+ $pattern =~ s#\s+#\\s+#gs;
+ if ( $license_text =~ /\b$pattern\b/i ) {
+ return $license;
+ }
+ }
+ return '';
+}
+
+sub license_from {
+ my $self = 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<(
+ https?\Q://rt.cpan.org/\E[^>]+|
+ https?\Q://github.com/\E[\w_]+/[\w_]+/issues|
+ https?\Q://code.google.com/p/\E[\w_\-]+/issues/list
+ )>#gx;
+ my %links;
+ @links{@links}=();
+ @links=keys %links;
+ return @links;
+}
+
+sub bugtracker_from {
+ my $self = shift;
+ my $content = Module::Install::_read($_[0]);
+ my @links = _extract_bugtracker($content);
+ unless ( @links ) {
+ warn "Cannot determine bugtracker info from $_[0]\n";
+ return 0;
+ }
+ if ( @links > 1 ) {
+ warn "Found more than one bugtracker link in $_[0]\n";
+ return 0;
+ }
+
+ # Set the bugtracker
+ bugtracker( $links[0] );
+ return 1;
+}
+
+sub requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+(v?[\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->requires( $module => $version );
+ }
+}
+
+sub test_requires_from {
+ my $self = shift;
+ my $content = Module::Install::_readperl($_[0]);
+ my @requires = $content =~ m/^use\s+([^\W\d]\w*(?:::\w+)*)\s+([\d\.]+)/mg;
+ while ( @requires ) {
+ my $module = shift @requires;
+ my $version = shift @requires;
+ $self->test_requires( $module => $version );
+ }
+}
+
+# Convert triple-part versions (eg, 5.6.1 or 5.8.9) to
+# numbers (eg, 5.006001 or 5.008009).
+# Also, convert double-part versions (eg, 5.8)
+sub _perl_version {
+ my $v = $_[-1];
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)$/sprintf("%d.%03d",$1,$2)/e;
+ $v =~ s/^([1-9])\.([1-9]\d?\d?)\.(0|[1-9]\d?\d?)$/sprintf("%d.%03d%03d",$1,$2,$3 || 0)/e;
+ $v =~ s/(\.\d\d\d)000$/$1/;
+ $v =~ s/_.+$//;
+ if ( ref($v) ) {
+ # Numify
+ $v = $v + 0;
+ }
+ return $v;
+}
+
+sub add_metadata {
+ my $self = shift;
+ my %hash = @_;
+ for my $key (keys %hash) {
+ warn "add_metadata: $key is not prefixed with 'x_'.\n" .
+ "Use appopriate function to add non-private metadata.\n" unless $key =~ /^x_/;
+ $self->{values}->{$key} = $hash{$key};
+ }
+}
+
+
+######################################################################
+# MYMETA Support
+
+sub WriteMyMeta {
+ die "WriteMyMeta has been deprecated";
+}
+
+sub write_mymeta_yaml {
+ my $self = shift;
+
+ # We need YAML::Tiny to write the MYMETA.yml file
+ unless ( eval { require YAML::Tiny; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.yml\n";
+ YAML::Tiny::DumpFile('MYMETA.yml', $meta);
+}
+
+sub write_mymeta_json {
+ my $self = shift;
+
+ # We need JSON to write the MYMETA.json file
+ unless ( eval { require JSON; 1; } ) {
+ return 1;
+ }
+
+ # Generate the data
+ my $meta = $self->_write_mymeta_data or return 1;
+
+ # Save as the MYMETA.yml file
+ print "Writing MYMETA.json\n";
+ Module::Install::_write(
+ 'MYMETA.json',
+ JSON->new->pretty(1)->canonical->encode($meta),
+ );
+}
+
+sub _write_mymeta_data {
+ my $self = shift;
+
+ # If there's no existing META.yml there is nothing we can do
+ return undef unless -f 'META.yml';
+
+ # We need Parse::CPAN::Meta to load the file
+ unless ( eval { require Parse::CPAN::Meta; 1; } ) {
+ return undef;
+ }
+
+ # Merge the perl version into the dependencies
+ my $val = $self->Meta->{values};
+ my $perl = delete $val->{perl_version};
+ if ( $perl ) {
+ $val->{requires} ||= [];
+ my $requires = $val->{requires};
+
+ # Canonize to three-dot version after Perl 5.6
+ if ( $perl >= 5.006 ) {
+ $perl =~ s{^(\d+)\.(\d\d\d)(\d*)}{join('.', $1, int($2||0), int($3||0))}e
+ }
+ unshift @$requires, [ perl => $perl ];
+ }
+
+ # Load the advisory META.yml file
+ my @yaml = Parse::CPAN::Meta::LoadFile('META.yml');
+ my $meta = $yaml[0];
+
+ # Overwrite the non-configure dependency hashs
+ delete $meta->{requires};
+ delete $meta->{build_requires};
+ delete $meta->{recommends};
+ if ( exists $val->{requires} ) {
+ $meta->{requires} = { map { @$_ } @{ $val->{requires} } };
+ }
+ if ( exists $val->{build_requires} ) {
+ $meta->{build_requires} = { map { @$_ } @{ $val->{build_requires} } };
+ }
+
+ return $meta;
+}
+
+1;
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
new file mode 100644
index 0000000..73b9cda
--- /dev/null
+++ b/inc/Module/Install/RTx.pm
@@ -0,0 +1,231 @@
+#line 1
+package Module::Install::RTx;
+
+use 5.008;
+use strict;
+use warnings;
+no warnings 'once';
+
+use Module::Install::Base;
+use base 'Module::Install::Base';
+our $VERSION = '0.29';
+
+use FindBin;
+use File::Glob ();
+use File::Basename ();
+
+my @DIRS = qw(etc lib html bin sbin po var);
+my @INDEX_DIRS = qw(lib bin sbin);
+
+sub RTx {
+ my ( $self, $name ) = @_;
+
+ my $original_name = $name;
+ my $RTx = 'RTx';
+ $RTx = $1 if $name =~ s/^(\w+)-//;
+ my $fname = $name;
+ $fname =~ s!-!/!g;
+
+ $self->name("$RTx-$name")
+ unless $self->name;
+ $self->all_from( -e "$name.pm" ? "$name.pm" : "lib/$RTx/$fname.pm" )
+ unless $self->version;
+ $self->abstract("RT $name Extension")
+ unless $self->abstract;
+
+ my @prefixes = (qw(/opt /usr/local /home /usr /sw ));
+ my $prefix = $ENV{PREFIX};
+ @ARGV = grep { /PREFIX=(.*)/ ? ( ( $prefix = $1 ), 0 ) : 1 } @ARGV;
+
+ if ($prefix) {
+ $RT::LocalPath = $prefix;
+ $INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
+ } else {
+ local @INC = (
+ $ENV{RTHOME} ? ( $ENV{RTHOME}, "$ENV{RTHOME}/lib" ) : (),
+ @INC,
+ map { ( "$_/rt4/lib", "$_/lib/rt4", "$_/rt3/lib", "$_/lib/rt3", "$_/lib" )
+ } grep $_, @prefixes
+ );
+ until ( eval { require RT; $RT::LocalPath } ) {
+ warn
+ "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
+ $_ = $self->prompt("Path to directory containing your RT.pm:") or exit;
+ $_ =~ s/\/RT\.pm$//;
+ push @INC, $_, "$_/rt3/lib", "$_/lib/rt3", "$_/lib";
+ }
+ }
+
+ my $lib_path = File::Basename::dirname( $INC{'RT.pm'} );
+ my $local_lib_path = "$RT::LocalPath/lib";
+ print "Using RT configuration from $INC{'RT.pm'}:\n";
+ unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
+ unshift @INC, $lib_path;
+
+ $RT::LocalVarPath ||= $RT::VarPath;
+ $RT::LocalPoPath ||= $RT::LocalLexiconPath;
+ $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+ $RT::LocalLibPath ||= "$RT::LocalPath/lib";
+
+ my $with_subdirs = $ENV{WITH_SUBDIRS};
+ @ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
+ @ARGV;
+
+ my %subdirs;
+ %subdirs = map { $_ => 1 } split( /\s*,\s*/, $with_subdirs )
+ if defined $with_subdirs;
+ unless ( keys %subdirs ) {
+ $subdirs{$_} = 1 foreach grep -d "$FindBin::Bin/$_", @DIRS;
+ }
+
+ # If we're running on RT 3.8 with plugin support, we really wany
+ # to install libs, mason templates and po files into plugin specific
+ # directories
+ my %path;
+ if ( $RT::LocalPluginPath ) {
+ die "Because of bugs in RT 3.8.0 this extension can not be installed.\n"
+ ."Upgrade to RT 3.8.1 or newer.\n" if $RT::VERSION =~ /^3\.8\.0/;
+ $path{$_} = $RT::LocalPluginPath . "/$original_name/$_"
+ foreach @DIRS;
+ } else {
+ foreach ( @DIRS ) {
+ no strict 'refs';
+ my $varname = "RT::Local" . ucfirst($_) . "Path";
+ $path{$_} = ${$varname} || "$RT::LocalPath/$_";
+ }
+
+ $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
+ }
+
+ my %index = map { $_ => 1 } @INDEX_DIRS;
+ $self->no_index( directory => $_ ) foreach grep !$index{$_}, @DIRS;
+
+ my $args = join ', ', map "q($_)", map { ($_, $path{$_}) }
+ grep $subdirs{$_}, keys %path;
+
+ print "./$_\t=> $path{$_}\n" for sort keys %subdirs;
+
+ if ( my @dirs = map { ( -D => $_ ) } grep $subdirs{$_}, qw(bin html sbin) ) {
+ my @po = map { ( -o => $_ ) }
+ grep -f,
+ File::Glob::bsd_glob("po/*.po");
+ $self->postamble(<< ".") if @po;
+lexicons ::
+\t\$(NOECHO) \$(PERL) -MLocale::Maketext::Extract::Run=xgettext -e \"xgettext(qw(@dirs @po))\"
+.
+ }
+
+ my $postamble = << ".";
+install ::
+\t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
+.
+
+ if ( $subdirs{var} and -d $RT::MasonDataDir ) {
+ my ( $uid, $gid ) = ( stat($RT::MasonDataDir) )[ 4, 5 ];
+ $postamble .= << ".";
+\t\$(NOECHO) chown -R $uid:$gid $path{var}
+.
+ }
+
+ 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}++;
+ }
+ if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
+
+ $self->postamble("$postamble\n");
+ unless ( $subdirs{'lib'} ) {
+ $self->makemaker_args( PM => { "" => "" }, );
+ } else {
+ $self->makemaker_args( INSTALLSITELIB => $path{'lib'} );
+ $self->makemaker_args( INSTALLARCHLIB => $path{'lib'} );
+ }
+
+ $self->makemaker_args( INSTALLSITEMAN1DIR => "$RT::LocalPath/man/man1" );
+ $self->makemaker_args( INSTALLSITEMAN3DIR => "$RT::LocalPath/man/man3" );
+ $self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" );
+
+ if (%has_etc) {
+ $self->load('RTxInitDB');
+ 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))"
+.
+ $initdb .= <<"." if $has_etc{acl};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
+.
+ $initdb .= <<"." if $has_etc{initialdata};
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
+.
+ $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,
+ alpha => -4,
+ b => -3,
+ beta => -3,
+ pre => -2,
+ rc => -1,
+ head => 9999,
+);
+sub cmp_version($$) {
+ my ($a, $b) = (@_);
+ my @a = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
+ split /([^0-9]+)/, $a;
+ my @b = grep defined, map { /^[0-9]+$/? $_ : /^[a-zA-Z]+$/? $word{$_}|| -10 : undef }
+ split /([^0-9]+)/, $b;
+ @a > @b
+ ? push @b, (0) x (@a- at b)
+ : push @a, (0) x (@b- at a);
+ for ( my $i = 0; $i < @a; $i++ ) {
+ return $a[$i] <=> $b[$i] if $a[$i] <=> $b[$i];
+ }
+ return 0;
+}}
+sub requires_rt {
+ my ($self,$version) = @_;
+
+ # if we're exactly the same version as what we want, silently return
+ return if ($version eq $RT::VERSION);
+
+ my @sorted = sort cmp_version $version,$RT::VERSION;
+
+ if ($sorted[-1] eq $version) {
+ # should we die?
+ warn "\nWarning: prerequisite RT $version not found. Your installed version of RT ($RT::VERSION) is too old.\n\n";
+ }
+}
+
+1;
+
+__END__
+
+#line 348
diff --git a/inc/Module/Install/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
new file mode 100644
index 0000000..fb7075f
--- /dev/null
+++ b/inc/Module/Install/ReadmeFromPod.pm
@@ -0,0 +1,138 @@
+#line 1
+package Module::Install::ReadmeFromPod;
+
+use 5.006;
+use strict;
+use warnings;
+use base qw(Module::Install::Base);
+use vars qw($VERSION);
+
+$VERSION = '0.18';
+
+sub readme_from {
+ my $self = shift;
+ return unless $self->is_admin;
+
+ # Input file
+ my $in_file = shift || $self->_all_from
+ or die "Can't determine file to make readme_from";
+
+ # Get optional arguments
+ my ($clean, $format, $out_file, $options);
+ my $args = shift;
+ if ( ref $args ) {
+ # Arguments are in a hashref
+ if ( ref($args) ne 'HASH' ) {
+ die "Expected a hashref but got a ".ref($args)."\n";
+ } else {
+ $clean = $args->{'clean'};
+ $format = $args->{'format'};
+ $out_file = $args->{'output_file'};
+ $options = $args->{'options'};
+ }
+ } else {
+ # Arguments are in a list
+ $clean = $args;
+ $format = shift;
+ $out_file = shift;
+ $options = \@_;
+ }
+
+ # Default values;
+ $clean ||= 0;
+ $format ||= 'txt';
+
+ # Generate README
+ print "readme_from $in_file to $format\n";
+ if ($format =~ m/te?xt/) {
+ $out_file = $self->_readme_txt($in_file, $out_file, $options);
+ } elsif ($format =~ m/html?/) {
+ $out_file = $self->_readme_htm($in_file, $out_file, $options);
+ } elsif ($format eq 'man') {
+ $out_file = $self->_readme_man($in_file, $out_file, $options);
+ } elsif ($format eq 'pdf') {
+ $out_file = $self->_readme_pdf($in_file, $out_file, $options);
+ }
+
+ if ($clean) {
+ $self->clean_files($out_file);
+ }
+
+ return 1;
+}
+
+
+sub _readme_txt {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README';
+ require Pod::Text;
+ my $parser = Pod::Text->new( @$options );
+ open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
+ $parser->output_fh( *$out_fh );
+ $parser->parse_file( $in_file );
+ close $out_fh;
+ return $out_file;
+}
+
+
+sub _readme_htm {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.htm';
+ require Pod::Html;
+ Pod::Html::pod2html(
+ "--infile=$in_file",
+ "--outfile=$out_file",
+ @$options,
+ );
+ # Remove temporary files if needed
+ for my $file ('pod2htmd.tmp', 'pod2htmi.tmp') {
+ if (-e $file) {
+ unlink $file or warn "Warning: Could not remove file '$file'.\n$!\n";
+ }
+ }
+ return $out_file;
+}
+
+
+sub _readme_man {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.1';
+ require Pod::Man;
+ my $parser = Pod::Man->new( @$options );
+ $parser->parse_from_file($in_file, $out_file);
+ return $out_file;
+}
+
+
+sub _readme_pdf {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.pdf';
+ eval { require App::pod2pdf; }
+ or die "Could not generate $out_file because pod2pdf could not be found\n";
+ my $parser = App::pod2pdf->new( @$options );
+ $parser->parse_from_file($in_file);
+ open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
+ select $out_fh;
+ $parser->output;
+ select STDOUT;
+ close $out_fh;
+ return $out_file;
+}
+
+
+sub _all_from {
+ my $self = shift;
+ return unless $self->admin->{extensions};
+ my ($metadata) = grep {
+ ref($_) eq 'Module::Install::Metadata';
+ } @{$self->admin->{extensions}};
+ return unless $metadata;
+ return $metadata->{values}{all_from} || '';
+}
+
+'Readme!';
+
+__END__
+
+#line 254
+
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
new file mode 100644
index 0000000..eeaa3fe
--- /dev/null
+++ b/inc/Module/Install/Win32.pm
@@ -0,0 +1,64 @@
+#line 1
+package Module::Install::Win32;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+# determine if the user needs nmake, and download it if needed
+sub check_nmake {
+ my $self = shift;
+ $self->load('can_run');
+ $self->load('get_file');
+
+ require Config;
+ return unless (
+ $^O eq 'MSWin32' and
+ $Config::Config{make} and
+ $Config::Config{make} =~ /^nmake\b/i and
+ ! $self->can_run('nmake')
+ );
+
+ print "The required 'nmake' executable not found, fetching it...\n";
+
+ require File::Basename;
+ my $rv = $self->get_file(
+ url => 'http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe',
+ ftp_url => 'ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe',
+ local_dir => File::Basename::dirname($^X),
+ size => 51928,
+ run => 'Nmake15.exe /o > nul',
+ check_for => 'Nmake.exe',
+ remove => 1,
+ );
+
+ die <<'END_MESSAGE' unless $rv;
+
+-------------------------------------------------------------------------------
+
+Since you are using Microsoft Windows, you will need the 'nmake' utility
+before installation. It's available at:
+
+ http://download.microsoft.com/download/vc15/Patch/1.52/W95/EN-US/Nmake15.exe
+ or
+ ftp://ftp.microsoft.com/Softlib/MSLFILES/Nmake15.exe
+
+Please download the file manually, save it to a directory in %PATH% (e.g.
+C:\WINDOWS\COMMAND\), then launch the MS-DOS command line shell, "cd" to
+that directory, and run "Nmake15.exe" from there; that will create the
+'nmake.exe' file needed by this module.
+
+You may then resume the installation process described in README.
+
+-------------------------------------------------------------------------------
+END_MESSAGE
+
+}
+
+1;
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
new file mode 100644
index 0000000..85d8018
--- /dev/null
+++ b/inc/Module/Install/WriteAll.pm
@@ -0,0 +1,63 @@
+#line 1
+package Module::Install::WriteAll;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.06';
+ @ISA = qw{Module::Install::Base};
+ $ISCORE = 1;
+}
+
+sub WriteAll {
+ my $self = shift;
+ my %args = (
+ meta => 1,
+ sign => 0,
+ inline => 0,
+ check_nmake => 1,
+ @_,
+ );
+
+ $self->sign(1) if $args{sign};
+ $self->admin->WriteAll(%args) if $self->is_admin;
+
+ $self->check_nmake if $args{check_nmake};
+ unless ( $self->makemaker_args->{PL_FILES} ) {
+ # XXX: This still may be a bit over-defensive...
+ unless ($self->makemaker(6.25)) {
+ $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+ }
+ }
+
+ # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
+ # we clean it up properly ourself.
+ $self->realclean_files('MYMETA.yml');
+
+ if ( $args{inline} ) {
+ $self->Inline->write;
+ } else {
+ $self->Makefile->write;
+ }
+
+ # The Makefile write process adds a couple of dependencies,
+ # so write the META.yml files after the Makefile.
+ if ( $args{meta} ) {
+ $self->Meta->write;
+ }
+
+ # Experimental support for MYMETA
+ if ( $ENV{X_MYMETA} ) {
+ if ( $ENV{X_MYMETA} eq 'JSON' ) {
+ $self->Meta->write_mymeta_json;
+ } else {
+ $self->Meta->write_mymeta_yaml;
+ }
+ }
+
+ return 1;
+}
+
+1;
commit 6fc58263b35cb2d20fad08c99c427b9aa12e4855
Author: Thomas Sibley <trs at bestpractical.com>
Date: Mon Jul 23 20:41:02 2012 -0700
Add MANIFEST.SKIP
diff --git a/MANIFEST b/MANIFEST
index 6126376..2f8e362 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -14,5 +14,6 @@ inc/Module/Install/WriteAll.pm
lib/RT/Extension/MandatoryOnTransition.pm
Makefile.PL
MANIFEST This list of files
+MANIFEST.SKIP
META.yml
README
commit 86677dd2e4afe738ab3e6ad7616e31dfe59abe25
Author: Thomas Sibley <trs at bestpractical.com>
Date: Tue Oct 30 09:16:41 2012 -0700
Check in TODO notes about Create that were lingering locally
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index c6a452c..a92db9f 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -270,9 +270,33 @@ sub Config {
return;
}
-=head1 AUTHOR
+=head1 TODO
-Thomas Sibley <trs at bestpractical.com>
+=over 4
+
+=item Enforcement on Create
+
+Configuration syntax is tricky and goes hand in hand with functionality here.
+
+Do we allow separate field lists for on create, or re-use existing status
+transition syntax? That is, does C<< * -> resolved >> mean "a newly created
+resolved ticket" too?
+
+Components affected:
+
+ index.html / QuickCreate
+ Create.html
+ SelfService
+ Mobile
+
+=item Enforcement on other update pages
+
+ SelfService - can't do it without patches to <form> POST + additional callbacks
+ Basics - need to patch callback for skipping (at least)
+ Jumbo - need to patch callback for skipping (at least)
+ Mobile - n/a; doesn't show CFs on reply/update
+
+=back
=head1 BUGS
@@ -280,6 +304,10 @@ All bugs should be reported via
L<http://rt.cpan.org/Public/Dist/Display.html?Name=RT-Extension-MandatoryOnTransition>
or L<bug-RT-Extension-MandatoryOnTransition at rt.cpan.org>.
+=head1 AUTHOR
+
+Thomas Sibley <trs at bestpractical.com>
+
=head1 LICENSE AND COPYRIGHT
This software is Copyright (c) 2012 by Best Practical Solutions
commit 262a0b5570450522c60d4ff33b2aef5481827b4d
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Nov 1 09:40:35 2012 -0400
Add Test.pm.in and Makefile substitution config
diff --git a/META.yml b/META.yml
new file mode 100644
index 0000000..aac46b2
--- /dev/null
+++ b/META.yml
@@ -0,0 +1,24 @@
+---
+abstract: 'RT Extension-MandatoryOnTransition Extension'
+author:
+ - 'Thomas Sibley <trs at bestpractical.com>'
+build_requires:
+ ExtUtils::MakeMaker: 6.36
+configure_requires:
+ ExtUtils::MakeMaker: 6.36
+distribution_type: module
+dynamic_config: 1
+generated_by: 'Module::Install version 1.06'
+license: gplv2
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
+name: RT-Extension-MandatoryOnTransition
+no_index:
+ directory:
+ - html
+ - inc
+ - t
+resources:
+ license: http://opensource.org/licenses/gpl-license.php
+version: 0.01
diff --git a/Makefile.PL b/Makefile.PL
index cc6a2df..c948449 100644
--- a/Makefile.PL
+++ b/Makefile.PL
@@ -1,6 +1,5 @@
use inc::Module::Install;
-
RTx 'RT-Extension-MandatoryOnTransition';
all_from 'lib/RT/Extension/MandatoryOnTransition.pm';
readme_from 'lib/RT/Extension/MandatoryOnTransition.pm';
@@ -8,5 +7,27 @@ license 'gplv2';
requires_rt('4.0.0');
+my ($lp) = ($INC{'RT.pm'} =~ /^(.*)[\\\/]/);
+my $lib_path = join( ' ', "$RT::LocalPath/lib", $lp );
+
+# Straight from perldoc perlvar
+use Config;
+my $secure_perl_path = $Config{perlpath};
+if ($^O ne 'VMS') {
+ $secure_perl_path .= $Config{_exe}
+ unless $secure_perl_path =~ m/$Config{_exe}$/i;
+}
+
+substitute(
+ {
+ RT_LIB_PATH => $lib_path,
+ PERL => $ENV{PERL} || $secure_perl_path,
+ },
+ {
+ sufix => '.in'
+ },
+ qw(lib/RT/Extension/MandatoryOnTransition/Test.pm),
+);
+
sign;
WriteAll;
diff --git a/inc/Module/Install/Substitute.pm b/inc/Module/Install/Substitute.pm
new file mode 100644
index 0000000..56af7fe
--- /dev/null
+++ b/inc/Module/Install/Substitute.pm
@@ -0,0 +1,131 @@
+#line 1
+package Module::Install::Substitute;
+
+use strict;
+use warnings;
+use 5.008; # I don't care much about earlier versions
+
+use Module::Install::Base;
+our @ISA = qw(Module::Install::Base);
+
+our $VERSION = '0.03';
+
+require File::Temp;
+require File::Spec;
+require Cwd;
+
+#line 89
+
+sub substitute
+{
+ my $self = shift;
+ $self->{__subst} = shift;
+ $self->{__option} = {};
+ if( UNIVERSAL::isa( $_[0], 'HASH' ) ) {
+ my $opts = shift;
+ while( my ($k,$v) = each( %$opts ) ) {
+ $self->{__option}->{ lc( $k ) } = $v || '';
+ }
+ }
+ $self->_parse_options;
+
+ my @file = @_;
+ foreach my $f (@file) {
+ $self->_rewrite_file( $f );
+ }
+
+ return;
+}
+
+sub _parse_options
+{
+ my $self = shift;
+ my $cwd = Cwd::getcwd();
+ foreach my $t ( qw(from to) ) {
+ $self->{__option}->{$t} = $cwd unless $self->{__option}->{$t};
+ my $d = $self->{__option}->{$t};
+ die "Couldn't read directory '$d'" unless -d $d && -r _;
+ }
+}
+
+sub _rewrite_file
+{
+ my ($self, $file) = @_;
+ my $source = File::Spec->catfile( $self->{__option}{from}, $file );
+ $source .= $self->{__option}{sufix} if $self->{__option}{sufix};
+ unless( -f $source && -r _ ) {
+ print STDERR "Couldn't find file '$source'\n";
+ return;
+ }
+ my $dest = File::Spec->catfile( $self->{__option}{to}, $file );
+ return $self->__rewrite_file( $source, $dest );
+}
+
+sub __rewrite_file
+{
+ my ($self, $source, $dest) = @_;
+
+ my $mode = (stat($source))[2];
+
+ open my $sfh, "<$source" or die "Couldn't open '$source' for read";
+ print "Open input '$source' file for substitution\n";
+
+ my ($tmpfh, $tmpfname) = File::Temp::tempfile('mi-subst-XXXX', UNLINK => 1);
+ $self->__process_streams( $sfh, $tmpfh, ($source eq $dest)? 1: 0 );
+ close $sfh;
+
+ seek $tmpfh, 0, 0 or die "Couldn't seek in tmp file";
+
+ open my $dfh, ">$dest" or die "Couldn't open '$dest' for write";
+ print "Open output '$dest' file for substitution\n";
+
+ while( <$tmpfh> ) {
+ print $dfh $_;
+ }
+ close $dfh;
+ chmod $mode, $dest or "Couldn't change mode on '$dest'";
+}
+
+sub __process_streams
+{
+ my ($self, $in, $out, $replace) = @_;
+
+ my @queue = ();
+ my $subst = $self->{'__subst'};
+ my $re_subst = join('|', map {"\Q$_"} keys %{ $subst } );
+
+ while( my $str = <$in> ) {
+ if( $str =~ /^###\s*(before|replace|after)\:\s?(.*)$/s ) {
+ my ($action, $nstr) = ($1,$2);
+ $nstr =~ s/\@($re_subst)\@/$subst->{$1}/ge;
+
+ die "Replace action is bad idea for situations when dest is equal to source"
+ if $replace && $action eq 'replace';
+ if( $action eq 'before' ) {
+ die "no line before 'before' action" unless @queue;
+ # overwrite prev line;
+ pop @queue;
+ push @queue, $nstr;
+ push @queue, $str;
+ } elsif( $action eq 'replace' ) {
+ push @queue, $nstr;
+ } elsif( $action eq 'after' ) {
+ push @queue, $str;
+ push @queue, $nstr;
+ # skip one line;
+ <$in>;
+ }
+ } else {
+ push @queue, $str;
+ }
+ while( @queue > 3 ) {
+ print $out shift(@queue);
+ }
+ }
+ while( scalar @queue ) {
+ print $out shift(@queue);
+ }
+}
+
+1;
+
diff --git a/lib/RT/Extension/MandatoryOnTransition/Test.pm.in b/lib/RT/Extension/MandatoryOnTransition/Test.pm.in
new file mode 100644
index 0000000..a899d0f
--- /dev/null
+++ b/lib/RT/Extension/MandatoryOnTransition/Test.pm.in
@@ -0,0 +1,47 @@
+use strict;
+use warnings;
+
+### after: use lib qw(@RT_LIB_PATH@);
+use lib qw(/opt/rt4/local/lib /opt/rt4/lib);
+
+package RT::Extension::MandatoryOnTransition::Test;
+
+our @ISA;
+BEGIN {
+ local $@;
+ eval { require RT::Test; 1 } or do {
+ require Test::More;
+ Test::More::BAIL_OUT(
+ "requires 3.8 to run tests. Error:\n$@\n"
+ ."You may need to set PERL5LIB=/path/to/rt/lib"
+ );
+ };
+ push @ISA, 'RT::Test';
+}
+
+sub import {
+ my $class = shift;
+ my %args = @_;
+
+ $args{'requires'} ||= [];
+ if ( $args{'testing'} ) {
+ unshift @{ $args{'requires'} }, 'RT::Extension::MandatoryOnTransition';
+ } else {
+ $args{'testing'} = 'RT::Extension::MandatoryOnTransition';
+ }
+
+ $args{'config'} =<<CONFIG;
+Set( %MandatoryOnTransition,
+ '*' => {
+ 'open -> resolved' => [qw(TimeWorked)]
+ },
+);
+CONFIG
+
+ $class->SUPER::import( %args );
+ $class->export_to_level(1);
+
+ require RT::Extension::MandatoryOnTransition;
+}
+
+1;
commit 30f11b72dbad7221c97f1d413a5704065fa8cf13
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Nov 1 09:41:10 2012 -0400
Add some basic tests
diff --git a/t/basic.t b/t/basic.t
new file mode 100644
index 0000000..9ce4e5c
--- /dev/null
+++ b/t/basic.t
@@ -0,0 +1,38 @@
+use strict;
+use warnings;
+
+use RT::Extension::MandatoryOnTransition::Test tests => 20;
+
+use_ok('RT::Extension::MandatoryOnTransition');
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+ok( $m->login( 'root', 'password' ), 'logged in' );
+$m->get_ok($m->rt_base_url);
+
+diag "Try a resolve without TimeWorked";
+{
+ my $t = RT::Test->create_ticket(
+ Queue => 'General',
+ Subject => 'Test Mandatory On Resolve',
+ Content => 'Testing',
+ );
+
+ ok( $t->id, 'Created test ticket: ' . $t->id);
+ ok( $t->SetStatus('open'), 'Set status to open');
+ $m->goto_ticket($t->id);
+
+ $m->follow_link_ok( { text => 'Resolve' }, 'Try to resolve ticket');
+ $m->submit_form_ok( { form_name => 'TicketUpdate',
+ button => 'SubmitTicket',},
+ 'Submit resolve with no Time Worked');
+ $m->content_contains('Time Worked is required when changing Status to resolved');
+
+ $m->submit_form_ok( { form_name => 'TicketUpdate',
+ fields => { UpdateTimeWorked => 10 },
+ button => 'SubmitTicket',
+ }, 'Submit resolve with Time Worked');
+
+ $m->content_contains("TimeWorked changed from (no value) to '10'");
+ $m->content_contains("Status changed from 'open' to 'resolved'");
+}
commit 076edabc461b9e5d1d9d65282589a2c477e2502d
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Fri Nov 2 11:36:19 2012 -0400
Add mandatory checks on create and refactor for update
Move the mandatory checking logic into a new method CheckMandatoryFields
in the main module to make it available from both create and update.
Also make CheckMandatoryFields work with both update where a ticket
already exists and create where it hasn't yet been created.
diff --git a/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Create.html/BeforeCreate b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Create.html/BeforeCreate
new file mode 100644
index 0000000..c1bf5d2
--- /dev/null
+++ b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Create.html/BeforeCreate
@@ -0,0 +1,24 @@
+<%args>
+$ARGSRef
+$skip_create
+$results => []
+</%args>
+<%init>
+
+my $Queue = $ARGSRef->{Queue};
+my $QueueObj = RT::Queue->new($session{'CurrentUser'});
+$QueueObj->Load($Queue);
+
+my $errors_ref = RT::Extension::MandatoryOnTransition->CheckMandatoryFields(
+ ARGSRef => $ARGSRef,
+ From => "''",
+ To => $ARGSRef->{'Status'},
+ Queue => $QueueObj,
+);
+
+if (@$errors_ref) {
+ RT->Logger->debug("Preventing create because of missing mandatory fields");
+ $$skip_create = 1;
+ push @$results, @$errors_ref;
+}
+</%init>
diff --git a/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate
index b2328da..dd91b1d 100644
--- a/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate
+++ b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate
@@ -5,66 +5,16 @@ $skip_update
$results => []
</%args>
<%init>
-my ($core, $cfs) = RT::Extension::MandatoryOnTransition->RequiredFields(
+
+my $errors_ref = RT::Extension::MandatoryOnTransition->CheckMandatoryFields(
+ ARGSRef => $ARGSRef,
Ticket => $TicketObj,
To => $ARGSRef->{'Status'},
);
-return unless @$core or @$cfs;
-
-my @errors;
-
-# Check core fields, after canonicalization for update
-for my $field (@$core) {
- # Will we have a value on update?
- my $arg = $RT::Extension::MandatoryOnTransition::CORE_FOR_UPDATE{$field} || $field;
- next if defined $ARGSRef->{$arg} and length $ARGSRef->{$arg};
-
- # Do we have a value currently?
- next if grep { $_ eq $field } @RT::Extension::MandatoryOnTransition::CORE_TICKET
- and $TicketObj->$field();
-
- (my $label = $field) =~ s/(?<=[a-z])(?=[A-Z])/ /g; # /
- push @errors, loc("[_1] is required when changing Status to [_2]", $label, $ARGSRef->{Status});
-}
-
-# Find the CFs we want
-my $CFs = $TicketObj->CustomFields;
-$CFs->Limit( FIELD => 'Name', VALUE => $_, SUBCLAUSE => 'names', ENTRYAGGREGRATOR => 'OR' )
- for @$cfs;
-
-# Validate them
-my $ValidCFs = $m->comp(
- '/Elements/ValidateCustomFields',
- CustomFields => $CFs,
- NamePrefix => "Object-RT::Ticket-".$TicketObj->Id."-CustomField-",
- ARGSRef => $ARGSRef
-);
-
-# Check validation results and mandatory-ness
-while (my $cf = $CFs->Next) {
- # Is there a validation error?
- if ( not $ValidCFs and my $msg = $m->notes('InvalidField-' . $cf->Id)) {
- push @errors, loc($cf->Name) . ': ' . $msg;
- next;
- }
-
- # Do we have a submitted value for update?
- my $arg = "Object-RT::Ticket-".$TicketObj->Id."-CustomField-".$cf->Id."-Value";
- my $value = ($ARGSRef->{"${arg}s-Magic"} and exists $ARGSRef->{"${arg}s"})
- ? $ARGSRef->{$arg . "s"}
- : $ARGSRef->{$arg};
- next if defined $value and length $value;
-
- # Is there a current value? (Particularly important for Date/Datetime CFs
- # since they don't submit a value on update.)
- next if $cf->ValuesForObject($TicketObj)->Count;
-
- push @errors, loc("[_1] is required when changing Status to [_2]", $cf->Name, $ARGSRef->{Status});
-}
-if (@errors) {
+if (@$errors_ref) {
RT->Logger->debug("Preventing update because of missing mandatory fields");
$$skip_update = 1;
- push @$results, @errors;
+ push @$results, @$errors_ref;
}
</%init>
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index a92db9f..c4f1347 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -2,7 +2,7 @@ use strict;
use warnings;
package RT::Extension::MandatoryOnTransition;
-our $VERSION = '0.01';
+our $VERSION = '0.02';
=head1 NAME
@@ -251,6 +251,123 @@ sub RequiredFields {
return (\@core, \@cfs);
}
+=head3 CheckMandatoryFields
+
+Pulls core and custom mandatory fields from the configuration and
+checks that they have a value set before transitioning to the
+requested status.
+
+Accepts a paramhash of values:
+ ARGSRef => Reference to Mason ARGS
+ Ticket => ticket object being updated
+ Queue => Queue object for the queue in which a new ticket is being created
+ From => Ticket status transitioning from
+ To => Ticket status transitioning to
+
+Works for both create, where no ticket exists yet, and update on an
+existing ticket. ARGSRef is required for both.
+
+For create, you must also pass Queue, From, and To.
+
+Update requires only Ticket and To since From can be fetched from the
+ticket object.
+
+=cut
+
+sub CheckMandatoryFields {
+ my $self = shift;
+ my %args = (
+ Ticket => undef,
+ Queue => undef,
+ From => undef,
+ To => undef,
+ @_,
+ );
+ my $ARGSRef = $args{'ARGSRef'};
+
+ my @errors;
+
+ my ($core, $cfs) = RT::Extension::MandatoryOnTransition->RequiredFields(
+ Ticket => $args{'Ticket'},
+ Queue => $args{'Queue'} ? $args{'Queue'}->Name : undef,
+ From => $args{'From'},
+ To => $args{'To'},
+ );
+
+ return \@errors unless @$core or @$cfs;
+
+ # Check core fields, after canonicalization for update
+ for my $field (@$core) {
+ # Will we have a value on update?
+ # If we have a Ticket, it's an update, so use the CORE_FOR_UPDATE values
+ # otherwise it's a create so use raw field value with no UPDATE prefix
+ my $arg = $args{'Ticket'} ? $RT::Extension::MandatoryOnTransition::CORE_FOR_UPDATE{$field} || $field
+ : $field;
+ next if defined $ARGSRef->{$arg} and length $ARGSRef->{$arg};
+
+ # Do we have a value currently?
+ # In Create the ticket hasn't been created yet.
+ next if grep { $_ eq $field } @RT::Extension::MandatoryOnTransition::CORE_TICKET
+ and ($args{'Ticket'} && $args{'Ticket'}->$field());
+
+ (my $label = $field) =~ s/(?<=[a-z])(?=[A-Z])/ /g; # /
+ push @errors,
+ HTML::Mason::Commands::loc("[_1] is required when changing Status to [_2]",
+ $label, $ARGSRef->{Status});
+ }
+
+ # Find the CFs we want
+ my $CFs = $args{'Ticket'} ? $args{'Ticket'}->CustomFields
+ : $args{'Queue'}->TicketCustomFields();
+
+ if ( not $CFs ){
+ $RT::Logger->error("Custom Fields object required to process mandatory custom fields");
+ return \@errors;
+ }
+
+ $CFs->Limit( FIELD => 'Name', VALUE => $_, SUBCLAUSE => 'names', ENTRYAGGREGRATOR => 'OR' )
+ for @$cfs;
+
+ # For constructing NamePrefix for both update and create
+ my $TicketId = $args{'Ticket'} ? $args{'Ticket'}->Id : '';
+
+ # Validate them
+ my $ValidCFs = $HTML::Mason::Commands::m->comp(
+ '/Elements/ValidateCustomFields',
+ CustomFields => $CFs,
+ NamePrefix => "Object-RT::Ticket-".$TicketId."-CustomField-",
+ ARGSRef => $ARGSRef
+ );
+
+ # Check validation results and mandatory-ness
+ while (my $cf = $CFs->Next) {
+ # Is there a validation error?
+ if ( not $ValidCFs
+ and my $msg = $HTML::Mason::Commands::m->notes('InvalidField-' . $cf->Id)) {
+ push @errors, loc($cf->Name) . ': ' . $msg;
+ next;
+ }
+
+ # Do we have a submitted value for update?
+ my $arg = "Object-RT::Ticket-".$TicketId."-CustomField-".$cf->Id."-Value";
+ my $value = ($ARGSRef->{"${arg}s-Magic"} and exists $ARGSRef->{"${arg}s"})
+ ? $ARGSRef->{$arg . "s"}
+ : $ARGSRef->{$arg};
+
+ next if defined $value and length $value;
+
+ # Is there a current value? (Particularly important for Date/Datetime CFs
+ # since they don't submit a value on update.)
+ next if $args{'Ticket'} && $cf->ValuesForObject($args{'Ticket'})->Count;
+
+ push @errors,
+ HTML::Mason::Commands::loc("[_1] is required when changing Status to [_2]",
+ $cf->Name, $ARGSRef->{Status});
+ }
+
+ return \@errors;
+}
+
=head3 Config
Takes a queue name. Returns a hashref for the given queue (possibly using the
diff --git a/lib/RT/Extension/MandatoryOnTransition/Test.pm.in b/lib/RT/Extension/MandatoryOnTransition/Test.pm.in
index a899d0f..1723137 100644
--- a/lib/RT/Extension/MandatoryOnTransition/Test.pm.in
+++ b/lib/RT/Extension/MandatoryOnTransition/Test.pm.in
@@ -35,6 +35,9 @@ Set( %MandatoryOnTransition,
'*' => {
'open -> resolved' => [qw(TimeWorked)]
},
+ 'General' => {
+ '* -> resolved' => ['TimeWorked', 'CF.Test Field']
+ },
);
CONFIG
diff --git a/t/mandatory_on_create.t b/t/mandatory_on_create.t
new file mode 100644
index 0000000..3b2cd49
--- /dev/null
+++ b/t/mandatory_on_create.t
@@ -0,0 +1,58 @@
+use strict;
+use warnings;
+
+use RT::Extension::MandatoryOnTransition::Test tests => 19;
+
+use_ok('RT::Extension::MandatoryOnTransition');
+
+my ( $baseurl, $m ) = RT::Test->started_ok();
+
+ok( $m->login( 'root', 'password' ), 'logged in' );
+
+my $cf = RT::CustomField->new($RT::SystemUser);
+my ( $id, $ret, $msg );
+
+diag "Create custom field";
+( $id, $msg ) = $cf->Create(
+ Name => 'Test Field',
+ Type => 'Select',
+ LookupType => 'RT::Queue-RT::Ticket',
+ MaxValues => '1',
+ Queue => 'General',
+);
+
+ok( $id, $msg );
+$cf->AddValue( Name => 'foo' );
+$cf->AddValue( Name => 'bar' );
+
+diag "Test mandatory fields on create";
+{
+ $m->get_ok($m->rt_base_url);
+ $m->submit_form_ok( { form_name => 'CreateTicketInQueue',
+ fields => { Queue => 'General',},
+ }, 'Click button to create ticket');
+
+ $m->title_is('Create a new ticket');
+
+ $m->submit_form_ok( { form_name => 'TicketCreate',
+ fields => { Status => 'resolved' },
+ }, 'Submit with resolved status');
+
+ $m->content_contains('Time Worked is required when changing Status to resolved');
+ $m->content_contains('Test Field is required when changing Status to resolved');
+
+ $m->submit_form_ok( { form_name => 'TicketCreate',
+ fields => { Status => 'resolved',
+ 'Object-RT::Ticket--CustomField-1-Values' => 'foo'},
+ }, 'Submit with resolved status');
+
+ $m->content_contains('Time Worked is required when changing Status to resolved');
+
+ $m->submit_form_ok( { form_name => 'TicketCreate',
+ fields => { Status => 'resolved',
+ 'Object-RT::Ticket--CustomField-1-Values' => 'foo',
+ 'TimeWorked' => '10', },
+ }, 'Submit with resolved status');
+
+ $m->content_contains("Ticket 1 created in queue 'General'");
+}
diff --git a/t/required_fields.t b/t/required_fields.t
new file mode 100644
index 0000000..d5d7f63
--- /dev/null
+++ b/t/required_fields.t
@@ -0,0 +1,43 @@
+use strict;
+use warnings;
+
+use RT::Extension::MandatoryOnTransition::Test tests => 13;
+
+use_ok('RT::Extension::MandatoryOnTransition');
+
+diag "Test RequiredFields without a ticket";
+{
+ my ($core, $cf) = RT::Extension::MandatoryOnTransition->RequiredFields(
+ From => 'open',
+ To => 'resolved',
+ );
+ is( $core->[0], 'TimeWorked', 'Got TimeWorked for required core');
+
+ ($core, $cf) = RT::Extension::MandatoryOnTransition->RequiredFields(
+ From => "''",
+ To => 'resolved',
+ Queue => 'General',
+ );
+
+ is( $core->[0], 'TimeWorked', 'Got TimeWorked for required core');
+ is( $cf->[0], 'Test Field', 'Got Test Field for required custom field');
+}
+
+diag "Test RequiredFields with a ticket";
+{
+ my $t = RT::Test->create_ticket(
+ Queue => 'General',
+ Subject => 'Test Mandatory On Resolve',
+ Content => 'Testing',
+ );
+
+ ok( $t->id, 'Created test ticket: ' . $t->id);
+
+ my ($core, $cf) = RT::Extension::MandatoryOnTransition->RequiredFields(
+ Ticket => $t,
+ To => 'resolved',
+ );
+
+ is( $core->[0], 'TimeWorked', 'Got TimeWorked for required core');
+ is( $cf->[0], 'Test Field', 'Got Test Field for required custom field');
+}
commit 31c98413f041ff972e5c61ca41bd7932ff905e30
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Nov 5 14:31:26 2012 -0500
Default From to * on create to match any from state
diff --git a/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Create.html/BeforeCreate b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Create.html/BeforeCreate
index c1bf5d2..661d002 100644
--- a/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Create.html/BeforeCreate
+++ b/html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Create.html/BeforeCreate
@@ -11,7 +11,7 @@ $QueueObj->Load($Queue);
my $errors_ref = RT::Extension::MandatoryOnTransition->CheckMandatoryFields(
ARGSRef => $ARGSRef,
- From => "''",
+ From => "*",
To => $ARGSRef->{'Status'},
Queue => $QueueObj,
);
commit 7f878e3ff6a70ca96804379d975f9e5d05a748c3
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Nov 5 14:35:21 2012 -0500
Remove fully qualified package naming
Remove unnecessary full package name for method call and
referring to package variables.
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index c4f1347..332f938 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -287,7 +287,7 @@ sub CheckMandatoryFields {
my @errors;
- my ($core, $cfs) = RT::Extension::MandatoryOnTransition->RequiredFields(
+ my ($core, $cfs) = $self->RequiredFields(
Ticket => $args{'Ticket'},
Queue => $args{'Queue'} ? $args{'Queue'}->Name : undef,
From => $args{'From'},
@@ -301,13 +301,13 @@ sub CheckMandatoryFields {
# Will we have a value on update?
# If we have a Ticket, it's an update, so use the CORE_FOR_UPDATE values
# otherwise it's a create so use raw field value with no UPDATE prefix
- my $arg = $args{'Ticket'} ? $RT::Extension::MandatoryOnTransition::CORE_FOR_UPDATE{$field} || $field
+ my $arg = $args{'Ticket'} ? $CORE_FOR_UPDATE{$field} || $field
: $field;
next if defined $ARGSRef->{$arg} and length $ARGSRef->{$arg};
# Do we have a value currently?
# In Create the ticket hasn't been created yet.
- next if grep { $_ eq $field } @RT::Extension::MandatoryOnTransition::CORE_TICKET
+ next if grep { $_ eq $field } @CORE_TICKET
and ($args{'Ticket'} && $args{'Ticket'}->$field());
(my $label = $field) =~ s/(?<=[a-z])(?=[A-Z])/ /g; # /
commit 04f33e13cb58597d18d99215ad54d9905e6bfc46
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Nov 5 15:56:20 2012 -0500
Use CurrentUser->loc rather than calling back into Mason
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index 332f938..86fde4a 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -284,9 +284,23 @@ sub CheckMandatoryFields {
@_,
);
my $ARGSRef = $args{'ARGSRef'};
-
my @errors;
+ # Some convenience variables set depending on what gets passed
+ my ($CFs, $CurrentUser);
+ if ( $args{'Ticket'} ){
+ $CFs = $args{'Ticket'}->CustomFields;
+ $CurrentUser = $args{'Ticket'}->CurrentUser();
+ }
+ elsif ( $args{'Queue'} ){
+ $CFs = $args{'Queue'}->TicketCustomFields;
+ $CurrentUser = $args{'Queue'}->CurrentUser();
+ }
+ else{
+ $RT::Logger->error("CheckMandatoryFields requires a Ticket object or a Queue object");
+ return \@errors;
+ }
+
my ($core, $cfs) = $self->RequiredFields(
Ticket => $args{'Ticket'},
Queue => $args{'Queue'} ? $args{'Queue'}->Name : undef,
@@ -312,14 +326,10 @@ sub CheckMandatoryFields {
(my $label = $field) =~ s/(?<=[a-z])(?=[A-Z])/ /g; # /
push @errors,
- HTML::Mason::Commands::loc("[_1] is required when changing Status to [_2]",
+ $CurrentUser->loc("[_1] is required when changing Status to [_2]",
$label, $ARGSRef->{Status});
}
- # Find the CFs we want
- my $CFs = $args{'Ticket'} ? $args{'Ticket'}->CustomFields
- : $args{'Queue'}->TicketCustomFields();
-
if ( not $CFs ){
$RT::Logger->error("Custom Fields object required to process mandatory custom fields");
return \@errors;
@@ -344,7 +354,7 @@ sub CheckMandatoryFields {
# Is there a validation error?
if ( not $ValidCFs
and my $msg = $HTML::Mason::Commands::m->notes('InvalidField-' . $cf->Id)) {
- push @errors, loc($cf->Name) . ': ' . $msg;
+ push @errors, $CurrentUser->loc($cf->Name) . ': ' . $msg;
next;
}
@@ -361,7 +371,7 @@ sub CheckMandatoryFields {
next if $args{'Ticket'} && $cf->ValuesForObject($args{'Ticket'})->Count;
push @errors,
- HTML::Mason::Commands::loc("[_1] is required when changing Status to [_2]",
+ $CurrentUser->loc("[_1] is required when changing Status to [_2]",
$cf->Name, $ARGSRef->{Status});
}
commit 0463bab1228fd227d4b8757074d289b9c15cd2f4
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Mon Nov 5 16:24:34 2012 -0500
Add exception for TimeTaken on create
TimeTaken is only relevant on update, so skip if validating
on create.
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index 86fde4a..ad4e3b5 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -312,11 +312,20 @@ sub CheckMandatoryFields {
# Check core fields, after canonicalization for update
for my $field (@$core) {
+
# Will we have a value on update?
# If we have a Ticket, it's an update, so use the CORE_FOR_UPDATE values
# otherwise it's a create so use raw field value with no UPDATE prefix
- my $arg = $args{'Ticket'} ? $CORE_FOR_UPDATE{$field} || $field
- : $field;
+ my $arg;
+ if ( $args{'Ticket'} ){
+ $arg = $CORE_FOR_UPDATE{$field} || $field;
+ }
+ else{
+ # It's create. No TimeTaken on create form.
+ next if $field eq 'TimeTaken';
+ $arg = $field;
+ }
+
next if defined $ARGSRef->{$arg} and length $ARGSRef->{$arg};
# Do we have a value currently?
diff --git a/lib/RT/Extension/MandatoryOnTransition/Test.pm.in b/lib/RT/Extension/MandatoryOnTransition/Test.pm.in
index 1723137..d7ad18d 100644
--- a/lib/RT/Extension/MandatoryOnTransition/Test.pm.in
+++ b/lib/RT/Extension/MandatoryOnTransition/Test.pm.in
@@ -33,10 +33,10 @@ sub import {
$args{'config'} =<<CONFIG;
Set( %MandatoryOnTransition,
'*' => {
- 'open -> resolved' => [qw(TimeWorked)]
+ 'open -> resolved' => [qw(TimeWorked TimeTaken)]
},
'General' => {
- '* -> resolved' => ['TimeWorked', 'CF.Test Field']
+ '* -> resolved' => ['TimeWorked', 'TimeTaken', 'CF.Test Field']
},
);
CONFIG
commit 28af9babcd120b9b7903be449f0ce7a3dd4d46db
Author: Thomas Sibley <trs at bestpractical.com>
Date: Tue Nov 6 12:00:38 2012 -0800
Add a %CORE_FOR_CREATE mapping for greater flexibility
Now TimeTaken doesn't need a hardcoded "next if" inside the
CheckMandatoryFields method.
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index ad4e3b5..907930b 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -165,7 +165,7 @@ $RT::Config::META{'MandatoryOnTransition'} = {
=item @CORE_SUPPORTED
The core (basic) fields supported by the extension. Anything else configured
-not in this list is stripped.
+but not in this list is stripped.
=item @CORE_TICKET
@@ -175,13 +175,21 @@ check for current values.
=item %CORE_FOR_UPDATE
A mapping which translates core fields into their form input names. For
-example, Content is submitted as UpdateContent.
+example, Content is submitted as UpdateContent. All fields must be mapped,
+even if they are named exactly as listed in @CORE_SUPPORTED. A supported
+field which doesn't appear in the mapping is skipped, the implication being
+that it isn't available during update.
+
+=item %CORE_FOR_CREATE
+
+A mapping similar to %CORE_FOR_UPDATE but consulted during ticket creation.
+The same rules and restrictions apply.
=back
If you're looking to add support for other core fields, you'll need to push
-into @CORE_SUPPORTED and possibly @CORE_TICKET. You may also need to add a
-pair to %CORE_FOR_UPDATE.
+into @CORE_SUPPORTED and possibly @CORE_TICKET. You'll also need to add a
+pair to %CORE_FOR_UPDATE and/or %CORE_FOR_CREATE.
=cut
@@ -192,6 +200,10 @@ our %CORE_FOR_UPDATE = (
TimeTaken => 'UpdateTimeWorked',
Content => 'UpdateContent',
);
+our %CORE_FOR_CREATE = (
+ TimeWorked => 'TimeWorked',
+ Content => 'Content',
+);
=head2 Methods
@@ -313,19 +325,11 @@ sub CheckMandatoryFields {
# Check core fields, after canonicalization for update
for my $field (@$core) {
- # Will we have a value on update?
- # If we have a Ticket, it's an update, so use the CORE_FOR_UPDATE values
- # otherwise it's a create so use raw field value with no UPDATE prefix
- my $arg;
- if ( $args{'Ticket'} ){
- $arg = $CORE_FOR_UPDATE{$field} || $field;
- }
- else{
- # It's create. No TimeTaken on create form.
- next if $field eq 'TimeTaken';
- $arg = $field;
- }
-
+ # Will we have a value on update/create?
+ my $arg = $args{'Ticket'}
+ ? $CORE_FOR_UPDATE{$field}
+ : $CORE_FOR_CREATE{$field};
+ next unless $arg;
next if defined $ARGSRef->{$arg} and length $ARGSRef->{$arg};
# Do we have a value currently?
commit c2c5c3240b7515a5bd89acb675fd2e336a17d5d8
Author: Thomas Sibley <trs at bestpractical.com>
Date: Tue Nov 6 12:03:47 2012 -0800
Tests are author tests; installs from CPAN shouldn't run them
diff --git a/t/basic.t b/xt/basic.t
similarity index 100%
rename from t/basic.t
rename to xt/basic.t
diff --git a/t/mandatory_on_create.t b/xt/mandatory_on_create.t
similarity index 100%
rename from t/mandatory_on_create.t
rename to xt/mandatory_on_create.t
diff --git a/t/required_fields.t b/xt/required_fields.t
similarity index 100%
rename from t/required_fields.t
rename to xt/required_fields.t
commit d29823b7502c728c79479b79e1d67c5e30eb9640
Author: Thomas Sibley <trs at bestpractical.com>
Date: Tue Nov 6 12:05:14 2012 -0800
Ignore testing temp dir and generated Test.pm
diff --git a/.gitignore b/.gitignore
index e34e799..574f57b 100644
--- a/.gitignore
+++ b/.gitignore
@@ -11,3 +11,5 @@ README
*.bak
*.swp
/MYMETA.*
+/xt/tmp
+/lib/RT/Extension/MandatoryOnTransition/Test.pm
commit 88de111c5f840d7f19c9f768494bff5a165ca28b
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Fri Nov 9 16:39:19 2012 -0500
Add MandatoryOnTransition checking to the mobile create page
diff --git a/html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/create/BeforeCreate b/html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/create/BeforeCreate
new file mode 100644
index 0000000..661d002
--- /dev/null
+++ b/html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/create/BeforeCreate
@@ -0,0 +1,24 @@
+<%args>
+$ARGSRef
+$skip_create
+$results => []
+</%args>
+<%init>
+
+my $Queue = $ARGSRef->{Queue};
+my $QueueObj = RT::Queue->new($session{'CurrentUser'});
+$QueueObj->Load($Queue);
+
+my $errors_ref = RT::Extension::MandatoryOnTransition->CheckMandatoryFields(
+ ARGSRef => $ARGSRef,
+ From => "*",
+ To => $ARGSRef->{'Status'},
+ Queue => $QueueObj,
+);
+
+if (@$errors_ref) {
+ RT->Logger->debug("Preventing create because of missing mandatory fields");
+ $$skip_create = 1;
+ push @$results, @$errors_ref;
+}
+</%init>
diff --git a/xt/mandatory_on_create.t b/xt/mandatory_on_create.t
index 3b2cd49..0bf3729 100644
--- a/xt/mandatory_on_create.t
+++ b/xt/mandatory_on_create.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use RT::Extension::MandatoryOnTransition::Test tests => 19;
+use RT::Extension::MandatoryOnTransition::Test tests => 32;
use_ok('RT::Extension::MandatoryOnTransition');
@@ -56,3 +56,35 @@ diag "Test mandatory fields on create";
$m->content_contains("Ticket 1 created in queue 'General'");
}
+
+diag "Test mandatory fields on create for mobile";
+{
+ $m->get_ok($m->rt_base_url . '/m/');
+ $m->follow_link_ok( { text => 'New ticket' }, 'Click New ticket');
+ $m->title_is('Create a ticket');
+ $m->follow_link_ok( { text => 'General' }, 'Click General queue');
+ $m->title_is('Create a ticket');
+
+ $m->submit_form_ok( { form_name => 'TicketCreate',
+ fields => { Status => 'resolved' },
+ }, 'Submit with resolved status');
+
+ $m->content_contains('Time Worked is required when changing Status to resolved');
+ $m->content_contains('Test Field is required when changing Status to resolved');
+
+ $m->submit_form_ok( { form_name => 'TicketCreate',
+ fields => { Status => 'resolved',
+ 'Object-RT::Ticket--CustomField-1-Values' => 'foo'},
+ }, 'Submit with resolved status');
+
+ $m->content_contains('Time Worked is required when changing Status to resolved');
+
+ $m->submit_form_ok( { form_name => 'TicketCreate',
+ fields => { Status => 'resolved',
+ 'Object-RT::Ticket--CustomField-1-Values' => 'foo',
+ 'TimeWorked' => '10', },
+ }, 'Submit with resolved status');
+
+ $m->title_like(qr/#(\d+):/, 'Looks like a ticket number in the title');
+ like($m->uri->as_string, qr/show/, "On show page after ticket create");
+}
commit 86accd9d868faf2c7f6f777713c08fe962765128
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Tue Nov 13 16:39:16 2012 -0500
Add MandatoryOnTransition checking on mobile updates
This update requires the included patch to add the needed
callbacks to the mobile reply page.
diff --git a/html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/reply/AfterWorked b/html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/reply/AfterWorked
new file mode 100644
index 0000000..dc7ccff
--- /dev/null
+++ b/html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/reply/AfterWorked
@@ -0,0 +1,20 @@
+<%args>
+$Ticket
+</%args>
+<%init>
+
+my ($core, $cfs) = RT::Extension::MandatoryOnTransition->RequiredFields(
+ Ticket => $Ticket,
+ To => $ARGS{'Status'} || $ARGS{'DefaultStatus'},
+);
+
+return unless @$cfs;
+
+</%init>
+%# 'Named' is handled by this extension in the MassageCustomFields callback
+<& /Ticket/Elements/EditCustomFields,
+ %ARGS,
+ TicketObj => $Ticket,
+ InTable => 0,
+ Named => $cfs,
+ &>
diff --git a/html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/reply/BeforeUpdate b/html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/reply/BeforeUpdate
new file mode 100644
index 0000000..dd91b1d
--- /dev/null
+++ b/html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/reply/BeforeUpdate
@@ -0,0 +1,20 @@
+<%args>
+$TicketObj
+$ARGSRef
+$skip_update
+$results => []
+</%args>
+<%init>
+
+my $errors_ref = RT::Extension::MandatoryOnTransition->CheckMandatoryFields(
+ ARGSRef => $ARGSRef,
+ Ticket => $TicketObj,
+ To => $ARGSRef->{'Status'},
+);
+
+if (@$errors_ref) {
+ RT->Logger->debug("Preventing update because of missing mandatory fields");
+ $$skip_update = 1;
+ push @$results, @$errors_ref;
+}
+</%init>
diff --git a/patches/4.0.9-additional-mobile-callbacks.diff b/patches/4.0.9-additional-mobile-callbacks.diff
new file mode 100644
index 0000000..120546f
--- /dev/null
+++ b/patches/4.0.9-additional-mobile-callbacks.diff
@@ -0,0 +1,53 @@
+diff --git a/share/html/m/_elements/raw_style b/share/html/m/_elements/raw_style
+index 02c95b5..e19e2a6 100644
+--- a/share/html/m/_elements/raw_style
++++ b/share/html/m/_elements/raw_style
+@@ -153,7 +153,7 @@ hr.clear {
+ }
+
+
+-.label, .labeltop {
++.label, .labeltop, .cflabel {
+ font-weight: normal;
+ }
+ .value {
+@@ -449,7 +449,7 @@ div.txn-content {
+
+ }
+
+-.label {
++.label, .cflabel {
+ text-align: left;
+ width: 10em;
+ color: #666;
+diff --git a/share/html/m/ticket/reply b/share/html/m/ticket/reply
+index 00c8e2b..18587bc 100644
+--- a/share/html/m/ticket/reply
++++ b/share/html/m/ticket/reply
+@@ -81,6 +81,7 @@
+ InUnits => $ARGS{'UpdateTimeWorked-TimeUnits'}||'minutes',
+ &>
+ </span></div>
++% $m->callback( %ARGS, CallbackName => 'AfterWorked', Ticket => $t );
+ <input type="hidden" class="hidden" name="id" value="<%$t->Id%>" /><br />
+ <div class="entry"><span class="label"><&|/l&>Update Type</&>:</span>
+ <div class="value"><select name="UpdateType">
+@@ -240,12 +241,17 @@ $m->comp( '/Elements/GnuPG/SignEncryptWidget:Process',
+ TicketObj => $t,
+ );
+
+-if ( !$checks_failure && exists $ARGS{SubmitTicket} ) {
++my $skip_update = 0;
++$m->callback( CallbackName => 'BeforeUpdate', ARGSRef => \%ARGS, skip_update => \$skip_update,
++ checks_failure => $checks_failure, results => \@results, TicketObj => $t );
++
++if ( !$checks_failure && !$skip_update && exists $ARGS{SubmitTicket} ) {
+ my $status = $m->comp('/Elements/GnuPG/SignEncryptWidget:Check',
+ self => $gnupg_widget,
+ TicketObj => $t,
+ );
+ $checks_failure = 1 unless $status;
++ $m->callback( Ticket => $t, ARGSRef => \%ARGS, CallbackName => 'BeforeDisplay' );
+ return $m->comp('/m/ticket/show', TicketObj => $t, %ARGS);
+ }
+ </%INIT>
diff --git a/xt/basic.t b/xt/basic.t
index 9ce4e5c..b8230bf 100644
--- a/xt/basic.t
+++ b/xt/basic.t
@@ -1,7 +1,7 @@
use strict;
use warnings;
-use RT::Extension::MandatoryOnTransition::Test tests => 20;
+use RT::Extension::MandatoryOnTransition::Test tests => 37;
use_ok('RT::Extension::MandatoryOnTransition');
@@ -10,6 +10,22 @@ my ( $baseurl, $m ) = RT::Test->started_ok();
ok( $m->login( 'root', 'password' ), 'logged in' );
$m->get_ok($m->rt_base_url);
+my $cf = RT::CustomField->new($RT::SystemUser);
+my ( $id, $ret, $msg );
+
+diag "Create custom field";
+( $id, $msg ) = $cf->Create(
+ Name => 'Test Field',
+ Type => 'Select',
+ LookupType => 'RT::Queue-RT::Ticket',
+ MaxValues => '1',
+ Queue => 'General',
+);
+
+ok( $id, $msg );
+$cf->AddValue( Name => 'foo' );
+$cf->AddValue( Name => 'bar' );
+
diag "Try a resolve without TimeWorked";
{
my $t = RT::Test->create_ticket(
@@ -27,12 +43,53 @@ diag "Try a resolve without TimeWorked";
button => 'SubmitTicket',},
'Submit resolve with no Time Worked');
$m->content_contains('Time Worked is required when changing Status to resolved');
+ $m->content_contains('Test Field is required when changing Status to resolved');
$m->submit_form_ok( { form_name => 'TicketUpdate',
- fields => { UpdateTimeWorked => 10 },
+ fields => { UpdateTimeWorked => 10,
+ 'Object-RT::Ticket-' . $t->id . '-CustomField-1-Values' => 'foo'},
button => 'SubmitTicket',
- }, 'Submit resolve with Time Worked');
+ }, 'Submit resolve with Time Worked and Test Field');
$m->content_contains("TimeWorked changed from (no value) to '10'");
$m->content_contains("Status changed from 'open' to 'resolved'");
}
+
+diag "Try a resolve without TimeWorked in mobile interface";
+{
+ $m->get_ok($m->rt_base_url . "/m/");
+
+ $m->follow_link_ok( { text => 'New ticket' }, 'Click New ticket');
+ $m->title_is('Create a ticket');
+ $m->follow_link_ok( { text => 'General' }, 'Click General queue');
+ $m->title_is('Create a ticket');
+
+ $m->submit_form_ok( { form_name => 'TicketCreate',
+ }, 'Create new ticket');
+
+ my $title = $m->title();
+ my ($ticket_id) = $title =~ /^#(\d+)/;
+ like( $ticket_id, qr/\d+/, "Got number $ticket_id for ticket id");
+
+ $m->get_ok($m->rt_base_url . "/m/ticket/show/?id=$ticket_id");
+
+ $m->follow_link_ok( { text => 'Reply' }, 'Click Reply link');
+
+ $m->submit_form_ok( { form_number => 1,
+ fields => { Status => 'resolved' },
+ button => 'SubmitTicket',
+ }, 'Submit resolve with no Time Worked');
+
+ $m->content_contains('Time Worked is required when changing Status to resolved');
+ $m->content_contains('Test Field is required when changing Status to resolved');
+
+ $m->submit_form_ok( { form_number => 1,
+ fields => { UpdateTimeWorked => 10,
+ 'Object-RT::Ticket-' . $ticket_id . '-CustomField-1-Values' => 'foo'},
+ button => 'SubmitTicket',
+ }, 'Submit resolve with Time Worked and Test Field');
+
+ # Try to confirm the page was updated.
+ $m->title_like(qr/^#$ticket_id:/, "Page title starts with ticket number $ticket_id");
+ like($m->uri->as_string, qr/show/, "On show page after ticket resolve");
+}
commit 9999ac10d29e1897a6b2ae6a22cbd9f78f84b77e
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Wed Nov 14 13:32:38 2012 -0500
Update patch install file and instructions
Add patch step to install instructions and properly
name patch file.
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index 907930b..3e2b809 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -82,6 +82,11 @@ Quick actions may be supported in a future release.
May need root permissions
+=item patch -p1 < 4.0.8-additional-mobile-callbacks-plus-style.diff
+
+Run the above in your /opt/rt4 directory to patch RT if on version 4.0.8
+or older.
+
=item Enable and configure this extension
Add this line to </opt/rt4/etc/RT_SiteConfig.pm>:
diff --git a/patches/4.0.9-additional-mobile-callbacks.diff b/patches/4.0.8-additional-mobile-callbacks-plus-style.diff
similarity index 100%
rename from patches/4.0.9-additional-mobile-callbacks.diff
rename to patches/4.0.8-additional-mobile-callbacks-plus-style.diff
index 120546f..41e15d7 100644
--- a/patches/4.0.9-additional-mobile-callbacks.diff
+++ b/patches/4.0.8-additional-mobile-callbacks-plus-style.diff
@@ -1,25 +1,3 @@
-diff --git a/share/html/m/_elements/raw_style b/share/html/m/_elements/raw_style
-index 02c95b5..e19e2a6 100644
---- a/share/html/m/_elements/raw_style
-+++ b/share/html/m/_elements/raw_style
-@@ -153,7 +153,7 @@ hr.clear {
- }
-
-
--.label, .labeltop {
-+.label, .labeltop, .cflabel {
- font-weight: normal;
- }
- .value {
-@@ -449,7 +449,7 @@ div.txn-content {
-
- }
-
--.label {
-+.label, .cflabel {
- text-align: left;
- width: 10em;
- color: #666;
diff --git a/share/html/m/ticket/reply b/share/html/m/ticket/reply
index 00c8e2b..18587bc 100644
--- a/share/html/m/ticket/reply
@@ -51,3 +29,25 @@ index 00c8e2b..18587bc 100644
return $m->comp('/m/ticket/show', TicketObj => $t, %ARGS);
}
</%INIT>
+diff --git a/share/html/m/_elements/raw_style b/share/html/m/_elements/raw_style
+index 02c95b5..e19e2a6 100644
+--- a/share/html/m/_elements/raw_style
++++ b/share/html/m/_elements/raw_style
+@@ -153,7 +153,7 @@ hr.clear {
+ }
+
+
+-.label, .labeltop {
++.label, .labeltop, .cflabel {
+ font-weight: normal;
+ }
+ .value {
+@@ -449,7 +449,7 @@ div.txn-content {
+
+ }
+
+-.label {
++.label, .cflabel {
+ text-align: left;
+ width: 10em;
+ color: #666;
commit 94b62e4b0d1e1baa6515cbd5ca83e0635f3937a7
Author: Jim Brandt <jbrandt at bestpractical.com>
Date: Thu Nov 15 10:22:19 2012 -0500
Update TODO list
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index 3e2b809..f3b24cf 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -430,16 +430,13 @@ resolved ticket" too?
Components affected:
index.html / QuickCreate
- Create.html
SelfService
- Mobile
=item Enforcement on other update pages
SelfService - can't do it without patches to <form> POST + additional callbacks
Basics - need to patch callback for skipping (at least)
Jumbo - need to patch callback for skipping (at least)
- Mobile - n/a; doesn't show CFs on reply/update
=back
commit 4b1c73c466c8d57df2ee194f95f3abf000192417
Author: Thomas Sibley <trs at bestpractical.com>
Date: Wed Feb 27 11:23:59 2013 -0800
Correct preamble to the "On Create" notes under TODO
These questions are answered by previous implementation.
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index f3b24cf..870b42c 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -421,16 +421,8 @@ sub Config {
=item Enforcement on Create
-Configuration syntax is tricky and goes hand in hand with functionality here.
-
-Do we allow separate field lists for on create, or re-use existing status
-transition syntax? That is, does C<< * -> resolved >> mean "a newly created
-resolved ticket" too?
-
-Components affected:
-
- index.html / QuickCreate
- SelfService
+ index.html / QuickCreate - Not yet implemented.
+ SelfService - Not yet implemented.
=item Enforcement on other update pages
commit e5d734365a2e9458d1e75384df8f1d56bc3224fa
Author: Thomas Sibley <trs at bestpractical.com>
Date: Wed Feb 27 11:24:42 2013 -0800
Document what "from" and "to" are in "from -> to"
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index 870b42c..a9e0eb7 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -105,6 +105,10 @@ config option. This option takes the generic form of:
},
);
+C<from> and C<to> are expected to be valid status names. C<from> may also be
+C<*> which will apply to any status and also tickets about to be created with
+status C<to>.
+
The fallback for queues without specific rules is specified with C<'*'> where
the queue name would normally be.
commit bd9adddddc3f64baccd32aaba9e95ce1bc02dfc6
Author: Thomas Sibley <trs at bestpractical.com>
Date: Wed Feb 27 11:25:26 2013 -0800
Version 0.03
diff --git a/MANIFEST b/MANIFEST
index 2f8e362..b97925c 100644
--- a/MANIFEST
+++ b/MANIFEST
@@ -1,3 +1,7 @@
+html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/create/BeforeCreate
+html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/reply/AfterWorked
+html/Callbacks/RT-Extension-MandatoryOnTransition/m/ticket/reply/BeforeUpdate
+html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Create.html/BeforeCreate
html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Elements/EditCustomFields/MassageCustomFields
html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/AfterWorked
html/Callbacks/RT-Extension-MandatoryOnTransition/Ticket/Update.html/BeforeUpdate
@@ -9,11 +13,18 @@ inc/Module/Install/Makefile.pm
inc/Module/Install/Metadata.pm
inc/Module/Install/ReadmeFromPod.pm
inc/Module/Install/RTx.pm
+inc/Module/Install/Substitute.pm
inc/Module/Install/Win32.pm
inc/Module/Install/WriteAll.pm
lib/RT/Extension/MandatoryOnTransition.pm
+lib/RT/Extension/MandatoryOnTransition/Test.pm
+lib/RT/Extension/MandatoryOnTransition/Test.pm.in
Makefile.PL
MANIFEST This list of files
MANIFEST.SKIP
META.yml
+patches/4.0.8-additional-mobile-callbacks-plus-style.diff
README
+xt/basic.t
+xt/mandatory_on_create.t
+xt/required_fields.t
diff --git a/META.yml b/META.yml
index aac46b2..342400c 100644
--- a/META.yml
+++ b/META.yml
@@ -18,7 +18,7 @@ no_index:
directory:
- html
- inc
- - t
+ - xt
resources:
license: http://opensource.org/licenses/gpl-license.php
-version: 0.01
+version: 0.03
diff --git a/inc/Module/Install/RTx.pm b/inc/Module/Install/RTx.pm
index 73b9cda..abf6aea 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,13 +8,13 @@ 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 ();
use File::Basename ();
-my @DIRS = qw(etc lib html bin sbin po var);
+my @DIRS = qw(etc lib html static bin sbin po var);
my @INDEX_DIRS = qw(lib bin sbin);
sub RTx {
@@ -62,10 +62,11 @@ sub RTx {
unshift @INC, "$RT::LocalPath/lib" if $RT::LocalPath;
unshift @INC, $lib_path;
- $RT::LocalVarPath ||= $RT::VarPath;
- $RT::LocalPoPath ||= $RT::LocalLexiconPath;
- $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
- $RT::LocalLibPath ||= "$RT::LocalPath/lib";
+ $RT::LocalVarPath ||= $RT::VarPath;
+ $RT::LocalPoPath ||= $RT::LocalLexiconPath;
+ $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+ $RT::LocalStaticPath ||= $RT::StaticPath;
+ $RT::LocalLibPath ||= "$RT::LocalPath/lib";
my $with_subdirs = $ENV{WITH_SUBDIRS};
@ARGV = grep { /WITH_SUBDIRS=(.*)/ ? ( ( $with_subdirs = $1 ), 0 ) : 1 }
@@ -129,18 +130,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 +154,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 +209,4 @@ sub requires_rt {
__END__
-#line 348
+#line 329
diff --git a/inc/Module/Install/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
index fb7075f..6a80818 100644
--- a/inc/Module/Install/ReadmeFromPod.pm
+++ b/inc/Module/Install/ReadmeFromPod.pm
@@ -7,7 +7,7 @@ use warnings;
use base qw(Module::Install::Base);
use vars qw($VERSION);
-$VERSION = '0.18';
+$VERSION = '0.20';
sub readme_from {
my $self = shift;
diff --git a/lib/RT/Extension/MandatoryOnTransition.pm b/lib/RT/Extension/MandatoryOnTransition.pm
index a9e0eb7..cb85aee 100644
--- a/lib/RT/Extension/MandatoryOnTransition.pm
+++ b/lib/RT/Extension/MandatoryOnTransition.pm
@@ -2,7 +2,7 @@ use strict;
use warnings;
package RT::Extension::MandatoryOnTransition;
-our $VERSION = '0.02';
+our $VERSION = '0.03';
=head1 NAME
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list