[Bps-public-commit] RT-Extension-MenubarSearches branch, master, updated. 0.06-6-g912f339
Dustin Graves
dustin at bestpractical.com
Tue May 10 17:40:11 EDT 2016
The branch, master has been updated
via 912f339c8e8012f3c80ecd85a3947fd393e7918c (commit)
via 39454384599dbc1aae5085d66517b8399d1bfba6 (commit)
via 7e30cffc630b55acbbe9f0fb2b4f65d720211b6e (commit)
via 4fd44655e98f865a5ee54c7336bbbd812a3955b5 (commit)
from 0bb4d25e5d06f09f1f232098d3807b4457bbcef7 (commit)
Summary of changes:
.gitignore | 14 +
META.yml | 28 +-
README | 44 +-
inc/Module/Install.pm | 288 ++++++++----
inc/Module/Install/Base.pm | 65 +--
inc/Module/Install/Can.pm | 100 ++++-
inc/Module/Install/Fetch.pm | 12 +-
inc/Module/Install/Include.pm | 34 ++
inc/Module/Install/Makefile.pm | 279 +++++++++---
inc/Module/Install/Metadata.pm | 559 ++++++++++++++++-------
inc/Module/Install/RTx.pm | 270 +++++++----
inc/Module/Install/RTx/Runtime.pm | 79 ++++
inc/Module/Install/ReadmeFromPod.pm | 138 ++++++
inc/Module/Install/Win32.pm | 6 +-
inc/Module/Install/WriteAll.pm | 31 +-
inc/YAML/Tiny.pm | 874 ++++++++++++++++++++++++++++++++++++
lib/RT/Extension/MenubarSearches.pm | 108 ++++-
17 files changed, 2455 insertions(+), 474 deletions(-)
create mode 100644 inc/Module/Install/Include.pm
create mode 100644 inc/Module/Install/RTx/Runtime.pm
create mode 100644 inc/Module/Install/ReadmeFromPod.pm
create mode 100644 inc/YAML/Tiny.pm
- Log -----------------------------------------------------------------
commit 4fd44655e98f865a5ee54c7336bbbd812a3955b5
Author: Dustin Graves <dustin at bestpractical.com>
Date: Tue May 10 21:20:17 2016 +0000
updated .gitignore to current standard
diff --git a/.gitignore b/.gitignore
index e69de29..2cf4d88 100644
--- a/.gitignore
+++ b/.gitignore
@@ -0,0 +1,14 @@
+blib*
+Makefile
+Makefile.old
+pm_to_blib*
+*.tar.gz
+.lwpcookies
+cover_db
+pod2htm*.tmp
+/RT-Extension-MenubarSearches*
+*.bak
+*.swp
+/MYMETA.*
+/t/tmp
+/xt/tmp
commit 7e30cffc630b55acbbe9f0fb2b4f65d720211b6e
Author: Dustin Graves <dustin at bestpractical.com>
Date: Tue May 10 21:21:00 2016 +0000
updated Module::Install
diff --git a/META.yml b/META.yml
index 9a84259..ac859a7 100644
--- a/META.yml
+++ b/META.yml
@@ -1,11 +1,25 @@
-abstract: RT lib/RT/Extension/MenubarSearches.pm Extension
+---
+abstract: 'RT-Extension-MenubarSearches Extension'
+build_requires:
+ ExtUtils::MakeMaker: 6.59
+configure_requires:
+ ExtUtils::MakeMaker: 6.59
distribution_type: module
-generated_by: Module::Install version 0.63
-license: Perl
+dynamic_config: 1
+generated_by: 'Module::Install version 1.16'
+license: perl
+meta-spec:
+ url: http://module-build.sourceforge.net/META-spec-v1.4.html
+ version: 1.4
name: RT-Extension-MenubarSearches
-no_index:
- directory:
+no_index:
+ directory:
- html
- inc
- - t
-version: 0.05
+requires:
+ perl: 5.8.3
+resources:
+ license: http://dev.perl.org/licenses/
+version: '0.06'
+x_module_install_rtx_version: '0.37'
+x_requires_rt: 4.0.0
diff --git a/inc/Module/Install.pm b/inc/Module/Install.pm
index 87bed66..f44ab4d 100644
--- a/inc/Module/Install.pm
+++ b/inc/Module/Install.pm
@@ -17,12 +17,13 @@ package Module::Install;
# 3. The ./inc/ version of Module::Install loads
# }
-BEGIN {
- require 5.004;
-}
+use 5.006;
use strict 'vars';
+use Cwd ();
+use File::Find ();
+use File::Path ();
-use vars qw{$VERSION};
+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
@@ -30,25 +31,35 @@ BEGIN {
# This is not enforced yet, but will be some time in the next few
# releases once we can make sure it won't clash with custom
# Module::Install extensions.
- $VERSION = '0.76';
+ $VERSION = '1.16';
+
+ # 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;
-
-
-
-# Whether or not inc::Module::Install is actually loaded, the
-# $INC{inc/Module/Install.pm} is what will still get set as long as
-# the caller loaded module this in the documented manner.
-# If not set, the caller may NOT have loaded the bundled version, and thus
-# they may not have a MI version that works with the Makefile.PL. This would
-# result in false errors or unexpected behaviour. And we don't want that.
-my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
-unless ( $INC{$file} ) { die <<"END_DIE" }
+ #-------------------------------------------------------------
+ # all of the following checks should be included in import(),
+ # to allow "eval 'require Module::Install; 1' to test
+ # installation of Module::Install. (RT #51267)
+ #-------------------------------------------------------------
+
+ # Whether or not inc::Module::Install is actually loaded, the
+ # $INC{inc/Module/Install.pm} is what will still get set as long as
+ # the caller loaded module this in the documented manner.
+ # If not set, the caller may NOT have loaded the bundled version, and thus
+ # they may not have a MI version that works with the Makefile.PL. This would
+ # result in false errors or unexpected behaviour. And we don't want that.
+ my $file = join( '/', 'inc', split /::/, __PACKAGE__ ) . '.pm';
+ unless ( $INC{$file} ) { die <<"END_DIE" }
Please invoke ${\__PACKAGE__} with:
@@ -60,32 +71,42 @@ not:
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" }
-# 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 and (stat($0))[9] > time ) { die <<"END_DIE" }
-
-Your installer $0 has a modification time in the future.
+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" }
+ # 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.
@@ -95,47 +116,21 @@ 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));
+ #-------------------------------------------------------------
-
-# 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));
-
-
-
-
-
-use Cwd ();
-use File::Find ();
-use File::Path ();
-use FindBin;
-
-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 ( -f $self->{file} ) {
+ foreach my $key (keys %INC) {
+ delete $INC{$key} if $key =~ /Module\/Install/;
}
- $$sym =~ /([^:]+)$/ or die "Cannot autoload $who - $sym";
- unshift @_, ( $self, $1 );
- goto &{$self->can('call')} unless uc($1) eq $1;
- };
-}
-
-sub import {
- my $class = shift;
- my $self = $class->new(@_);
- my $who = $self->_caller;
- unless ( -f $self->{file} ) {
+ local $^W;
require "$self->{path}/$self->{dispatch}.pm";
File::Path::mkpath("$self->{prefix}/$self->{author}");
$self->{admin} = "$self->{name}::$self->{dispatch}"->new( _top => $self );
@@ -144,16 +139,61 @@ sub import {
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{"$self->{file}"};
- delete $INC{"$self->{path}.pm"};
+ 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::getcwd();
+ my $sym = "${who}::AUTOLOAD";
+ $sym->{$cwd} = sub {
+ my $pwd = Cwd::getcwd();
+ 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} ) {
@@ -164,8 +204,7 @@ sub preload {
my @exts = @{$self->{extensions}};
unless ( @exts ) {
- my $admin = $self->{admin};
- @exts = $admin->load_all_extensions;
+ @exts = $self->{admin}->load_all_extensions;
}
my %seen;
@@ -180,6 +219,7 @@ sub preload {
my $who = $self->_caller;
foreach my $name ( sort keys %seen ) {
+ local $^W;
*{"${who}::$name"} = sub {
${"${who}::AUTOLOAD"} = "${who}::$name";
goto &{"${who}::AUTOLOAD"};
@@ -190,12 +230,18 @@ sub preload {
sub new {
my ($class, %args) = @_;
+ delete $INC{'FindBin.pm'};
+ {
+ # to suppress the redefine warning
+ local $SIG{__WARN__} = sub {};
+ require FindBin;
+ }
+
# ignore the prefix on extension modules built from top level.
my $base_path = Cwd::abs_path($FindBin::Bin);
- unless ( Cwd::abs_path(Cwd::cwd()) eq $base_path ) {
+ unless ( Cwd::abs_path(Cwd::getcwd()) eq $base_path ) {
delete $args{prefix};
}
-
return $args{_self} if $args{_self};
$args{dispatch} ||= 'Admin';
@@ -248,8 +294,10 @@ END_DIE
sub load_extensions {
my ($self, $path, $top) = @_;
- unless ( grep { lc $_ eq lc $self->{prefix} } @INC ) {
+ 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) ) {
@@ -257,12 +305,13 @@ sub load_extensions {
next if $self->{pathnames}{$pkg};
local $@;
- my $new = eval { require $file; $pkg->can('new') };
+ my $new = eval { local $^W; require $file; $pkg->can('new') };
unless ( $new ) {
warn $@ if $@;
next;
}
- $self->{pathnames}{$pkg} = delete $INC{$file};
+ $self->{pathnames}{$pkg} =
+ $should_reload ? delete $INC{$file} : $INC{$file};
push @{$self->{extensions}}, &{$new}($pkg, _top => $top );
}
@@ -289,7 +338,7 @@ sub find_extensions {
if ( $subpath eq lc($subpath) || $subpath eq uc($subpath) ) {
my $content = Module::Install::_read($subpath . '.pm');
my $in_pod = 0;
- foreach ( split //, $content ) {
+ foreach ( split /\n/, $content ) {
$in_pod = 1 if /^=\w/;
$in_pod = 0 if /^=cut/;
next if ($in_pod || /^=cut/); # skip pod text
@@ -312,7 +361,7 @@ sub find_extensions {
#####################################################################
-# Utility Functions
+# Common Utility Functions
sub _caller {
my $depth = 0;
@@ -324,41 +373,102 @@ sub _caller {
return $call;
}
+# Done in evals to avoid confusing Perl::MinimumVersion
+eval( $] >= 5.006 ? <<'END_NEW' : <<'END_OLD' ); die $@ if $@;
+sub _read {
+ local *FH;
+ open( FH, '<', $_[0] ) or die "open($_[0]): $!";
+ binmode FH;
+ 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 $str = do { local $/; <FH> };
+ open( FH, "< $_[0]" ) or die "open($_[0]): $!";
+ binmode FH;
+ my $string = do { local $/; <FH> };
close FH or die "close($_[0]): $!";
- return $str;
+ 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]): $!";
+ binmode FH;
+ 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]): $!" }
+ open( FH, "> $_[0]" ) or die "open($_[0]): $!";
+ binmode FH;
+ foreach ( 1 .. $#_ ) {
+ print FH $_[$_] or die "print($_[0]): $!";
+ }
close FH or die "close($_[0]): $!";
}
+END_OLD
-sub _version ($) {
+# _version is for processing module versions (eg, 1.03_05) not
+# Perl versions (eg, 5.8.1).
+sub _version {
my $s = shift || 0;
- $s =~ s/^(\d+)\.?//;
+ 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;
+ 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 ($) {
+sub _CLASS {
(
defined $_[0]
and
! ref $_[0]
and
- $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*$/s
+ $_[0] =~ m/^[^\W\d]\w*(?:::\w+)*\z/s
) ? $_[0] : undef;
}
1;
-# Copyright 2008 Adam Kennedy.
+# Copyright 2008 - 2012 Adam Kennedy.
diff --git a/inc/Module/Install/Base.pm b/inc/Module/Install/Base.pm
index 76b32f8..5762a74 100644
--- a/inc/Module/Install/Base.pm
+++ b/inc/Module/Install/Base.pm
@@ -1,7 +1,11 @@
#line 1
package Module::Install::Base;
-$VERSION = '0.76';
+use strict 'vars';
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = '1.16';
+}
# Suspend handler for "redefined" warnings
BEGIN {
@@ -9,54 +13,61 @@ BEGIN {
$SIG{__WARN__} = sub { $w };
}
-### This is the ONLY module that shouldn't have strict on
-# use strict;
-
-#line 41
+#line 42
sub new {
- my ($class, %args) = @_;
-
- foreach my $method ( qw(call load) ) {
- *{"$class\::$method"} = sub {
- shift()->_top->$method(@_);
- } unless defined &{"$class\::$method"};
- }
-
- bless( \%args, $class );
+ 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 {
- my $self = shift;
- local $@;
- my $autoload = eval { $self->_top->autoload } or return;
- goto &$autoload;
+ local $@;
+ my $func = eval { shift->_top->autoload } or return;
+ goto &$func;
}
-#line 76
+#line 75
-sub _top { $_[0]->{_top} }
+sub _top {
+ $_[0]->{_top};
+}
-#line 89
+#line 90
sub admin {
- $_[0]->_top->{admin} or Module::Install::Base::FakeAdmin->new;
+ $_[0]->_top->{admin}
+ or
+ Module::Install::Base::FakeAdmin->new;
}
-#line 101
+#line 106
sub is_admin {
- $_[0]->admin->VERSION;
+ ! $_[0]->admin->isa('Module::Install::Base::FakeAdmin');
}
sub DESTROY {}
package Module::Install::Base::FakeAdmin;
-my $Fake;
-sub new { $Fake ||= bless(\@_, $_[0]) }
+use vars qw{$VERSION};
+BEGIN {
+ $VERSION = $Module::Install::Base::VERSION;
+}
+
+my $fake;
+
+sub new {
+ $fake ||= bless(\@_, $_[0]);
+}
sub AUTOLOAD {}
@@ -69,4 +80,4 @@ BEGIN {
1;
-#line 146
+#line 159
diff --git a/inc/Module/Install/Can.pm b/inc/Module/Install/Can.pm
index dd9a81c..d859276 100644
--- a/inc/Module/Install/Can.pm
+++ b/inc/Module/Install/Can.pm
@@ -2,18 +2,15 @@
package Module::Install::Can;
use strict;
-use Module::Install::Base;
-use Config ();
-### This adds a 5.005 Perl version dependency.
-### This is a bug and will be fixed.
-use File::Spec ();
-use ExtUtils::MakeMaker ();
-
-use vars qw{$VERSION $ISCORE @ISA};
+use Config ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.76';
+ $VERSION = '1.16';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
# check if we can load some module
@@ -31,7 +28,7 @@ sub can_use {
eval { require $mod; $pkg->VERSION($ver || 0); 1 };
}
-# check if we can run some command
+# Check if we can run some command
sub can_run {
my ($self, $cmd) = @_;
@@ -39,14 +36,89 @@ sub can_run {
return $_cmd if (-x $_cmd or $_cmd = MM->maybe_command($_cmd));
for my $dir ((split /$Config::Config{path_sep}/, $ENV{PATH}), '.') {
- my $abs = File::Spec->catfile($dir, $_[1]);
+ 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 we locate a (the) C compiler
+# Can our C compiler environment build XS files
+sub can_xs {
+ my $self = shift;
+
+ # Ensure we have the CBuilder module
+ $self->configure_requires( 'ExtUtils::CBuilder' => 0.27 );
+
+ # Do we have the configure_requires checker?
+ local $@;
+ eval "require ExtUtils::CBuilder;";
+ if ( $@ ) {
+ # They don't obey configure_requires, so it is
+ # someone old and delicate. Try to avoid hurting
+ # them by falling back to an older simpler test.
+ return $self->can_cc();
+ }
+
+ # Do we have a working C compiler
+ my $builder = ExtUtils::CBuilder->new(
+ quiet => 1,
+ );
+ unless ( $builder->have_compiler ) {
+ # No working C compiler
+ return 0;
+ }
+
+ # Write a C file representative of what XS becomes
+ require File::Temp;
+ my ( $FH, $tmpfile ) = File::Temp::tempfile(
+ "compilexs-XXXXX",
+ SUFFIX => '.c',
+ );
+ binmode $FH;
+ print $FH <<'END_C';
+#include "EXTERN.h"
+#include "perl.h"
+#include "XSUB.h"
+
+int main(int argc, char **argv) {
+ return 0;
+}
+
+int boot_sanexs() {
+ return 1;
+}
+
+END_C
+ close $FH;
+
+ # Can the C compiler access the same headers XS does
+ my @libs = ();
+ my $object = undef;
+ eval {
+ local $^W = 0;
+ $object = $builder->compile(
+ source => $tmpfile,
+ );
+ @libs = $builder->link(
+ objects => $object,
+ module_name => 'sanexs',
+ );
+ };
+ my $result = $@ ? 0 : 1;
+
+ # Clean up all the build files
+ foreach ( $tmpfile, $object, @libs ) {
+ next unless defined $_;
+ 1 while unlink;
+ }
+
+ return $result;
+}
+
+# Can we locate a (the) C compiler
sub can_cc {
my $self = shift;
my @chunks = split(/ /, $Config::Config{cc}) or return;
@@ -79,4 +151,4 @@ if ( $^O eq 'cygwin' ) {
__END__
-#line 157
+#line 236
diff --git a/inc/Module/Install/Fetch.pm b/inc/Module/Install/Fetch.pm
index 58df9ff..41d3517 100644
--- a/inc/Module/Install/Fetch.pm
+++ b/inc/Module/Install/Fetch.pm
@@ -2,24 +2,24 @@
package Module::Install::Fetch;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.76';
+ $VERSION = '1.16';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub get_file {
my ($self, %args) = @_;
- my ($scheme, $host, $path, $file) =
+ 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) =
+ ($scheme, $host, $path, $file) =
$args{url} =~ m|^(\w+)://([^/]+)(.+)/(.+)| or return;
}
diff --git a/inc/Module/Install/Include.pm b/inc/Module/Install/Include.pm
new file mode 100644
index 0000000..2eb1d1f
--- /dev/null
+++ b/inc/Module/Install/Include.pm
@@ -0,0 +1,34 @@
+#line 1
+package Module::Install::Include;
+
+use strict;
+use Module::Install::Base ();
+
+use vars qw{$VERSION @ISA $ISCORE};
+BEGIN {
+ $VERSION = '1.16';
+ @ISA = 'Module::Install::Base';
+ $ISCORE = 1;
+}
+
+sub include {
+ shift()->admin->include(@_);
+}
+
+sub include_deps {
+ shift()->admin->include_deps(@_);
+}
+
+sub auto_include {
+ shift()->admin->auto_include(@_);
+}
+
+sub auto_include_deps {
+ shift()->admin->auto_include_deps(@_);
+}
+
+sub auto_include_dependent_dists {
+ shift()->admin->auto_include_dependent_dists(@_);
+}
+
+1;
diff --git a/inc/Module/Install/Makefile.pm b/inc/Module/Install/Makefile.pm
index 05af6ef..e9918d2 100644
--- a/inc/Module/Install/Makefile.pm
+++ b/inc/Module/Install/Makefile.pm
@@ -2,14 +2,15 @@
package Module::Install::Makefile;
use strict 'vars';
-use Module::Install::Base;
-use ExtUtils::MakeMaker ();
+use ExtUtils::MakeMaker ();
+use Module::Install::Base ();
+use Fcntl qw/:flock :seek/;
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.76';
+ $VERSION = '1.16';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
sub Makefile { $_[0] }
@@ -25,8 +26,8 @@ sub prompt {
die "Caught an potential prompt infinite loop ($c[1]|$c[2]|$_[0])";
}
- # In automated testing, always use defaults
- if ( $ENV{AUTOMATED_TESTING} and ! $ENV{PERL_MM_USE_DEFAULT} ) {
+ # In automated testing or non-interactive session, always use defaults
+ if ( ($ENV{AUTOMATED_TESTING} or -! -t STDIN) and ! $ENV{PERL_MM_USE_DEFAULT} ) {
local $ENV{PERL_MM_USE_DEFAULT} = 1;
goto &ExtUtils::MakeMaker::prompt;
} else {
@@ -34,21 +35,112 @@ sub prompt {
}
}
+# Store a cleaned up version of the MakeMaker version,
+# since we need to behave differently in a variety of
+# ways based on the MM version.
+my $makemaker = eval $ExtUtils::MakeMaker::VERSION;
+
+# If we are passed a param, do a "newer than" comparison.
+# Otherwise, just return the MakeMaker version.
+sub makemaker {
+ ( @_ < 2 or $makemaker >= eval($_[1]) ) ? $makemaker : 0
+}
+
+# Ripped from ExtUtils::MakeMaker 6.56, and slightly modified
+# as we only need to know here whether the attribute is an array
+# or a hash or something else (which may or may not be appendable).
+my %makemaker_argtype = (
+ C => 'ARRAY',
+ CONFIG => 'ARRAY',
+# CONFIGURE => 'CODE', # ignore
+ DIR => 'ARRAY',
+ DL_FUNCS => 'HASH',
+ DL_VARS => 'ARRAY',
+ EXCLUDE_EXT => 'ARRAY',
+ EXE_FILES => 'ARRAY',
+ FUNCLIST => 'ARRAY',
+ H => 'ARRAY',
+ IMPORTS => 'HASH',
+ INCLUDE_EXT => 'ARRAY',
+ LIBS => 'ARRAY', # ignore ''
+ MAN1PODS => 'HASH',
+ MAN3PODS => 'HASH',
+ META_ADD => 'HASH',
+ META_MERGE => 'HASH',
+ PL_FILES => 'HASH',
+ PM => 'HASH',
+ PMLIBDIRS => 'ARRAY',
+ PMLIBPARENTDIRS => 'ARRAY',
+ PREREQ_PM => 'HASH',
+ CONFIGURE_REQUIRES => 'HASH',
+ SKIP => 'ARRAY',
+ TYPEMAPS => 'ARRAY',
+ XS => 'HASH',
+# VERSION => ['version',''], # ignore
+# _KEEP_AFTER_FLUSH => '',
+
+ clean => 'HASH',
+ depend => 'HASH',
+ dist => 'HASH',
+ dynamic_lib=> 'HASH',
+ linkext => 'HASH',
+ macro => 'HASH',
+ postamble => 'HASH',
+ realclean => 'HASH',
+ test => 'HASH',
+ tool_autosplit => 'HASH',
+
+ # special cases where you can use makemaker_append
+ CCFLAGS => 'APPENDABLE',
+ DEFINE => 'APPENDABLE',
+ INC => 'APPENDABLE',
+ LDDLFLAGS => 'APPENDABLE',
+ LDFROM => 'APPENDABLE',
+);
+
sub makemaker_args {
- my $self = shift;
+ my ($self, %new_args) = @_;
my $args = ( $self->{makemaker_args} ||= {} );
- %$args = ( %$args, @_ );
+ foreach my $key (keys %new_args) {
+ if ($makemaker_argtype{$key}) {
+ if ($makemaker_argtype{$key} eq 'ARRAY') {
+ $args->{$key} = [] unless defined $args->{$key};
+ unless (ref $args->{$key} eq 'ARRAY') {
+ $args->{$key} = [$args->{$key}]
+ }
+ push @{$args->{$key}},
+ ref $new_args{$key} eq 'ARRAY'
+ ? @{$new_args{$key}}
+ : $new_args{$key};
+ }
+ elsif ($makemaker_argtype{$key} eq 'HASH') {
+ $args->{$key} = {} unless defined $args->{$key};
+ foreach my $skey (keys %{ $new_args{$key} }) {
+ $args->{$key}{$skey} = $new_args{$key}{$skey};
+ }
+ }
+ elsif ($makemaker_argtype{$key} eq 'APPENDABLE') {
+ $self->makemaker_append($key => $new_args{$key});
+ }
+ }
+ else {
+ if (defined $args->{$key}) {
+ warn qq{MakeMaker attribute "$key" is overriden; use "makemaker_append" to append values\n};
+ }
+ $args->{$key} = $new_args{$key};
+ }
+ }
return $args;
}
-# For mm args that take multiple space-seperated args,
+# For mm args that take multiple space-separated args,
# append an argument to the current list.
sub makemaker_append {
- my $self = sShift;
+ my $self = shift;
my $name = shift;
my $args = $self->makemaker_args;
- $args->{name} = defined $args->{$name}
- ? join( ' ', $args->{name}, @_ )
+ $args->{$name} = defined $args->{$name}
+ ? join( ' ', $args->{$name}, @_ )
: join( ' ', @_ );
}
@@ -64,7 +156,7 @@ sub clean_files {
my $self = shift;
my $clean = $self->makemaker_args->{clean} ||= {};
%$clean = (
- %$clean,
+ %$clean,
FILES => join ' ', grep { length $_ } ($clean->{FILES} || (), @_),
);
}
@@ -73,7 +165,7 @@ sub realclean_files {
my $self = shift;
my $realclean = $self->makemaker_args->{realclean} ||= {};
%$realclean = (
- %$realclean,
+ %$realclean,
FILES => join ' ', grep { length $_ } ($realclean->{FILES} || (), @_),
);
}
@@ -89,99 +181,173 @@ sub inc {
$self->makemaker_args( INC => shift );
}
-my %test_dir = ();
-
sub _wanted_t {
- /\.t$/ and -f $_ and $test_dir{$File::Find::dir} = 1;
}
sub tests_recursive {
my $self = shift;
- if ( $self->tests ) {
- die "tests_recursive will not work if tests are already defined";
- }
my $dir = shift || 't';
unless ( -d $dir ) {
die "tests_recursive dir '$dir' does not exist";
}
- %test_dir = ();
+ my %tests = map { $_ => 1 } split / /, ($self->tests || '');
require File::Find;
- File::Find::find( \&_wanted_t, $dir );
- $self->tests( join ' ', map { "$_/*.t" } sort keys %test_dir );
+ File::Find::find(
+ sub { /\.t$/ and -f $_ and $tests{"$File::Find::dir/*.t"} = 1 },
+ $dir
+ );
+ $self->tests( join ' ', sort keys %tests );
}
sub write {
my $self = shift;
die "&Makefile->write() takes no arguments\n" if @_;
- # Make sure we have a new enough
- require ExtUtils::MakeMaker;
+ # 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";
+ }
- # MakeMaker can complain about module versions that include
- # an underscore, even though its own version may contain one!
- # Hence the funny regexp to get rid of it. See RT #35800
- # for details.
+ # Make sure we have a new enough MakeMaker
+ require ExtUtils::MakeMaker;
- $self->configure_requires( 'ExtUtils::MakeMaker' => $ExtUtils::MakeMaker::VERSION =~ /^(\d+\.\d+)/ );
+ 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
+ # Generate the MakeMaker params
my $args = $self->makemaker_args;
$args->{DISTNAME} = $self->name;
$args->{NAME} = $self->module_name || $self->name;
- $args->{VERSION} = $self->version;
$args->{NAME} =~ s/-/::/g;
+ $args->{VERSION} = $self->version or die <<'EOT';
+ERROR: Can't determine distribution version. Please specify it
+explicitly via 'version' in Makefile.PL, or set a valid $VERSION
+in a module, and provide its file path via 'version_from' (or
+'all_from' if you prefer) in Makefile.PL.
+EOT
+
if ( $self->tests ) {
- $args->{test} = { TESTS => $self->tests };
+ my @tests = split ' ', $self->tests;
+ my %seen;
+ $args->{test} = {
+ TESTS => (join ' ', grep {!$seen{$_}++} @tests),
+ };
+ } elsif ( $Module::Install::ExtraTests::use_extratests ) {
+ # Module::Install::ExtraTests doesn't set $self->tests and does its own tests via harness.
+ # So, just ignore our xt tests here.
+ } elsif ( -d 'xt' and ($Module::Install::AUTHOR or $ENV{RELEASE_TESTING}) ) {
+ $args->{test} = {
+ TESTS => join( ' ', map { "$_/*.t" } grep { -d $_ } qw{ t xt } ),
+ };
}
- if ($] >= 5.005) {
+ if ( $] >= 5.005 ) {
$args->{ABSTRACT} = $self->abstract;
- $args->{AUTHOR} = $self->author;
+ $args->{AUTHOR} = join ', ', @{$self->author || []};
}
- if ( eval($ExtUtils::MakeMaker::VERSION) >= 6.10 ) {
- $args->{NO_META} = 1;
+ if ( $self->makemaker(6.10) ) {
+ $args->{NO_META} = 1;
+ #$args->{NO_MYMETA} = 1;
}
- if ( eval($ExtUtils::MakeMaker::VERSION) > 6.17 and $self->sign ) {
+ if ( $self->makemaker(6.17) and $self->sign ) {
$args->{SIGN} = 1;
}
unless ( $self->is_admin ) {
delete $args->{SIGN};
}
+ if ( $self->makemaker(6.31) and $self->license ) {
+ $args->{LICENSE} = $self->license;
+ }
- # merge both kinds of requires into prereq_pm
my $prereq = ($args->{PREREQ_PM} ||= {});
%$prereq = ( %$prereq,
- map { @$_ }
+ map { @$_ } # flatten [module => version]
map { @$_ }
grep $_,
- ($self->configure_requires, $self->build_requires, $self->requires)
+ ($self->requires)
);
# Remove any reference to perl, PREREQ_PM doesn't support it
delete $args->{PREREQ_PM}->{perl};
- # merge both kinds of requires into prereq_pm
- my $subdirs = ($args->{DIR} ||= []);
+ # Merge both kinds of requires into BUILD_REQUIRES
+ my $build_prereq = ($args->{BUILD_REQUIRES} ||= {});
+ %$build_prereq = ( %$build_prereq,
+ map { @$_ } # flatten [module => version]
+ map { @$_ }
+ grep $_,
+ ($self->configure_requires, $self->build_requires)
+ );
+
+ # Remove any reference to perl, BUILD_REQUIRES doesn't support it
+ delete $args->{BUILD_REQUIRES}->{perl};
+
+ # Delete bundled dists from prereq_pm, add it to Makefile DIR
+ my $subdirs = ($args->{DIR} || []);
if ($self->bundles) {
+ my %processed;
foreach my $bundle (@{ $self->bundles }) {
- my ($file, $dir) = @$bundle;
- push @$subdirs, $dir if -d $dir;
- delete $prereq->{$file};
+ my ($mod_name, $dist_dir) = @$bundle;
+ delete $prereq->{$mod_name};
+ $dist_dir = File::Basename::basename($dist_dir); # dir for building this module
+ if (not exists $processed{$dist_dir}) {
+ if (-d $dist_dir) {
+ # List as sub-directory to be processed by make
+ push @$subdirs, $dist_dir;
+ }
+ # Else do nothing: the module is already present on the system
+ $processed{$dist_dir} = undef;
+ }
}
}
+ unless ( $self->makemaker('6.55_03') ) {
+ %$prereq = (%$prereq,%$build_prereq);
+ delete $args->{BUILD_REQUIRES};
+ }
+
if ( my $perl_version = $self->perl_version ) {
eval "use $perl_version; 1"
or die "ERROR: perl: Version $] is installed, "
. "but we need version >= $perl_version";
+
+ if ( $self->makemaker(6.48) ) {
+ $args->{MIN_PERL_VERSION} = $perl_version;
+ }
}
- $args->{INSTALLDIRS} = $self->installdirs;
+ if ($self->installdirs) {
+ warn qq{old INSTALLDIRS (probably set by makemaker_args) is overriden by installdirs\n} if $args->{INSTALLDIRS};
+ $args->{INSTALLDIRS} = $self->installdirs;
+ }
- my %args = map { ( $_ => $args->{$_} ) } grep {defined($args->{$_})} keys %$args;
+ my %args = map {
+ ( $_ => $args->{$_} ) } grep {defined($args->{$_} )
+ } keys %$args;
my $user_preop = delete $args{dist}->{PREOP};
- if (my $preop = $self->admin->preop($user_preop)) {
- $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);
@@ -194,7 +360,7 @@ sub fix_up_makefile {
my $top_class = ref($self->_top) || '';
my $top_version = $self->_top->VERSION || '';
- my $preamble = $self->preamble
+ my $preamble = $self->preamble
? "# Preamble by $top_class $top_version\n"
. $self->preamble
: '';
@@ -202,9 +368,9 @@ sub fix_up_makefile {
. ($self->postamble || '');
local *MAKEFILE;
- open MAKEFILE, "< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ open MAKEFILE, "+< $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ eval { flock MAKEFILE, LOCK_EX };
my $makefile = do { local $/; <MAKEFILE> };
- close MAKEFILE or die $!;
$makefile =~ s/\b(test_harness\(\$\(TEST_VERBOSE\), )/$1'inc', /;
$makefile =~ s/( -I\$\(INST_ARCHLIB\))/ -Iinc$1/g;
@@ -224,7 +390,8 @@ sub fix_up_makefile {
# XXX - This is currently unused; not sure if it breaks other MM-users
# $makefile =~ s/^pm_to_blib\s+:\s+/pm_to_blib :: /mg;
- open MAKEFILE, "> $makefile_name" or die "fix_up_makefile: Couldn't open $makefile_name: $!";
+ seek MAKEFILE, 0, SEEK_SET;
+ truncate MAKEFILE, 0;
print MAKEFILE "$preamble$makefile$postamble" or die $!;
close MAKEFILE or die $!;
@@ -248,4 +415,4 @@ sub postamble {
__END__
-#line 377
+#line 544
diff --git a/inc/Module/Install/Metadata.pm b/inc/Module/Install/Metadata.pm
index 90175f0..9792685 100644
--- a/inc/Module/Install/Metadata.pm
+++ b/inc/Module/Install/Metadata.pm
@@ -2,20 +2,23 @@
package Module::Install::Metadata;
use strict 'vars';
-use Module::Install::Base;
+use Module::Install::Base ();
-use vars qw{$VERSION $ISCORE @ISA};
+use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.76';
+ $VERSION = '1.16';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
- @ISA = qw{Module::Install::Base};
}
+my @boolean_keys = qw{
+ sign
+};
+
my @scalar_keys = qw{
name
module_name
abstract
- author
version
distribution_type
tests
@@ -37,16 +40,46 @@ my @resource_keys = qw{
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->{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;
};
}
@@ -55,12 +88,12 @@ foreach my $key ( @resource_keys ) {
*$key = sub {
my $self = shift;
unless ( @_ ) {
- return () unless $self->{values}{resources};
+ return () unless $self->{values}->{resources};
return map { $_->[1] }
grep { $_->[0] eq $key }
- @{ $self->{values}{resources} };
+ @{ $self->{values}->{resources} };
}
- return $self->{values}{resources}{$key} unless @_;
+ return $self->{values}->{resources}->{$key} unless @_;
my $uri = shift or die(
"Did not provide a value to $key()"
);
@@ -69,54 +102,19 @@ foreach my $key ( @resource_keys ) {
};
}
-sub requires {
- my $self = shift;
- while ( @_ ) {
- my $module = shift or last;
- my $version = shift || 0;
- push @{ $self->{values}{requires} }, [ $module, $version ];
- }
- $self->{values}{requires};
-}
-
-sub build_requires {
- my $self = shift;
- while ( @_ ) {
- my $module = shift or last;
- my $version = shift || 0;
- push @{ $self->{values}{build_requires} }, [ $module, $version ];
- }
- $self->{values}{build_requires};
-}
-
-sub configure_requires {
- my $self = shift;
- while ( @_ ) {
- my $module = shift or last;
- my $version = shift || 0;
- push @{ $self->{values}{configure_requires} }, [ $module, $version ];
- }
- $self->{values}{configure_requires};
-}
-
-sub recommends {
- my $self = shift;
- while ( @_ ) {
- my $module = shift or last;
- my $version = shift || 0;
- push @{ $self->{values}{recommends} }, [ $module, $version ];
- }
- $self->{values}{recommends};
-}
-
-sub bundles {
- my $self = shift;
- while ( @_ ) {
- my $module = shift or last;
- my $version = shift || 0;
- push @{ $self->{values}{bundles} }, [ $module, $version ];
- }
- $self->{values}{bundles};
+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
@@ -135,69 +133,55 @@ sub resources {
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} ||= [];
+ push @{ $self->{values}->{resources} }, [ $name, $value ];
}
- $self->{values}{resources};
+ $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(@_) }
+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 sign {
- my $self = shift;
- return $self->{values}{sign} if defined wantarray and ! @_;
- $self->{values}{sign} = ( @_ ? $_[0] : 1 );
- return $self;
-}
+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;
- unless ( @_ ) {
- warn "You MUST provide an explicit true/false value to dynamic_config\n";
- return $self;
+ my $self = shift;
+ my $value = @_ ? shift : 1;
+ if ( $self->{values}->{dynamic_config} ) {
+ # Once dynamic we never change to static, for safety
+ return 0;
}
- $self->{values}{dynamic_config} = $_[0] ? 1 : 0;
+ $self->{values}->{dynamic_config} = $value ? 1 : 0;
return 1;
}
+# Convenience command
+sub static_config {
+ shift->dynamic_config(0);
+}
+
sub perl_version {
my $self = shift;
- return $self->{values}{perl_version} unless @_;
+ return $self->{values}->{perl_version} unless @_;
my $version = shift or die(
"Did not provide a value to perl_version()"
);
- $version =~ s/_.+$//;
- $version = $version + 0; # Numify
- unless ( $version >= 5.005 ) {
- die "Module::Install only supports 5.005 or newer (use ExtUtils::MakeMaker)\n";
- }
- $self->{values}{perl_version} = $version;
- return 1;
-}
-sub license {
- my $self = shift;
- return $self->{values}{license} unless @_;
- my $license = shift or die(
- 'Did not provide a value to license()'
- );
- $self->{values}{license} = $license;
+ # Normalize the version
+ $version = $self->_perl_version($version);
- # Automatically fill in license URLs
- if ( $license eq 'perl' ) {
- $self->resources( license => 'http://dev.perl.org/licenses/' );
+ # 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";
}
- return 1;
+ $self->{values}->{perl_version} = $version;
}
sub all_from {
@@ -213,6 +197,11 @@ sub all_from {
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
@@ -224,7 +213,7 @@ sub all_from {
$self->name_from($file) unless $self->name;
$self->version_from($file) unless $self->version;
$self->perl_version_from($file) unless $self->perl_version;
- $self->author_from($pod) unless $self->author;
+ $self->author_from($pod) unless @{$self->author || []};
$self->license_from($pod) unless $self->license;
$self->abstract_from($pod) unless $self->abstract;
@@ -233,7 +222,7 @@ sub all_from {
sub provides {
my $self = shift;
- my $provides = ( $self->{values}{provides} ||= {} );
+ my $provides = ( $self->{values}->{provides} ||= {} );
%$provides = (%$provides, @_) if @_;
return $provides;
}
@@ -262,7 +251,7 @@ sub auto_provides {
sub feature {
my $self = shift;
my $name = shift;
- my $features = ( $self->{values}{features} ||= [] );
+ my $features = ( $self->{values}->{features} ||= [] );
my $mods;
if ( @_ == 1 and ref( $_[0] ) ) {
@@ -290,16 +279,16 @@ sub features {
while ( my ( $name, $mods ) = splice( @_, 0, 2 ) ) {
$self->feature( $name, @$mods );
}
- return $self->{values}{features}
- ? @{ $self->{values}{features} }
+ 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};
+ push @{ $self->{values}->{no_index}->{$type} }, @_ if $type;
+ return $self->{values}->{no_index};
}
sub read {
@@ -334,6 +323,9 @@ sub version_from {
require ExtUtils::MM_Unix;
my ( $self, $file ) = @_;
$self->version( ExtUtils::MM_Unix->parse_version($file) );
+
+ # for version integrity check
+ $self->makemaker_args( VERSION_FROM => $file );
}
sub abstract_from {
@@ -344,7 +336,7 @@ sub abstract_from {
{ DISTNAME => $self->name },
'ExtUtils::MM_Unix'
)->parse_abstract($file)
- );
+ );
}
# Add both distribution and module name
@@ -355,7 +347,7 @@ sub name_from {
^ \s*
package \s*
([\w:]+)
- \s* ;
+ [\s|;]*
/ixms
) {
my ($name, $module_name) = ($1, $1);
@@ -369,11 +361,10 @@ sub name_from {
}
}
-sub perl_version_from {
- my $self = shift;
+sub _extract_perl_version {
if (
- Module::Install::_read($_[0]) =~ m/
- ^
+ $_[0] =~ m/
+ ^\s*
(?:use|require) \s*
v?
([\d_\.]+)
@@ -382,6 +373,16 @@ sub perl_version_from {
) {
my $perl_version = $1;
$perl_version =~ s{_}{}g;
+ return $perl_version;
+ } else {
+ return;
+ }
+}
+
+sub perl_version_from {
+ my $self = shift;
+ my $perl_version=_extract_perl_version(Module::Install::_read($_[0]));
+ if ($perl_version) {
$self->perl_version($perl_version);
} else {
warn "Cannot determine perl version info from $_[0]\n";
@@ -401,66 +402,181 @@ sub author_from {
([^\n]*)
/ixms) {
my $author = $1 || $2;
- $author =~ s{E<lt>}{<}g;
- $author =~ s{E<gt>}{>}g;
+
+ # XXX: ugly but should work anyway...
+ if (eval "require Pod::Escapes; 1") {
+ # Pod::Escapes has a mapping table.
+ # It's in core of perl >= 5.9.3, and should be installed
+ # as one of the Pod::Simple's prereqs, which is a prereq
+ # of Pod::Text 3.x (see also below).
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $Pod::Escapes::Name2character_number{$1}
+ ? chr($Pod::Escapes::Name2character_number{$1})
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ elsif (eval "require Pod::Text; 1" && $Pod::Text::VERSION < 3) {
+ # Pod::Text < 3.0 has yet another mapping table,
+ # though the table name of 2.x and 1.x are different.
+ # (1.x is in core of Perl < 5.6, 2.x is in core of
+ # Perl < 5.9.3)
+ my $mapping = ($Pod::Text::VERSION < 2)
+ ? \%Pod::Text::HTML_Escapes
+ : \%Pod::Text::ESCAPES;
+ $author =~ s{ E<( (\d+) | ([A-Za-z]+) )> }
+ {
+ defined $2
+ ? chr($2)
+ : defined $mapping->{$1}
+ ? $mapping->{$1}
+ : do {
+ warn "Unknown escape: E<$1>";
+ "E<$1>";
+ };
+ }gex;
+ }
+ else {
+ $author =~ s{E<lt>}{<}g;
+ $author =~ s{E<gt>}{>}g;
+ }
$self->author($author);
} else {
warn "Cannot determine author info from $_[0]\n";
}
}
-sub license_from {
+#Stolen from M::B
+my %license_urls = (
+ perl => 'http://dev.perl.org/licenses/',
+ apache => 'http://apache.org/licenses/LICENSE-2.0',
+ apache_1_1 => 'http://apache.org/licenses/LICENSE-1.1',
+ artistic => 'http://opensource.org/licenses/artistic-license.php',
+ artistic_2 => 'http://opensource.org/licenses/artistic-license-2.0.php',
+ lgpl => 'http://opensource.org/licenses/lgpl-license.php',
+ lgpl2 => 'http://opensource.org/licenses/lgpl-2.1.php',
+ lgpl3 => 'http://opensource.org/licenses/lgpl-3.0.html',
+ bsd => 'http://opensource.org/licenses/bsd-license.php',
+ gpl => 'http://opensource.org/licenses/gpl-license.php',
+ gpl2 => 'http://opensource.org/licenses/gpl-2.0.php',
+ gpl3 => 'http://opensource.org/licenses/gpl-3.0.html',
+ mit => 'http://opensource.org/licenses/mit-license.php',
+ mozilla => 'http://opensource.org/licenses/mozilla1.1.php',
+ open_source => undef,
+ unrestricted => undef,
+ restrictive => undef,
+ unknown => undef,
+);
+
+sub license {
my $self = shift;
- if (
- Module::Install::_read($_[0]) =~ m/
- (
- =head \d \s+
- (?:licen[cs]e|licensing|copyright|legal)\b
- .*?
- )
- (=head\\d.*|=cut.*|)
- \z
- /ixms ) {
- my $license_text = $1;
- my @phrases = (
- 'under the same (?:terms|license) as perl itself' => 'perl', 1,
- 'GNU public license' => 'gpl', 1,
- 'GNU lesser public license' => 'lgpl', 1,
- 'BSD license' => 'bsd', 1,
- 'Artistic license' => 'artistic', 1,
- 'GPL' => 'gpl', 1,
- 'LGPL' => 'lgpl', 1,
- 'BSD' => 'bsd', 1,
- 'Artistic' => 'artistic', 1,
- 'MIT' => 'mit', 1,
- 'proprietary' => 'proprietary', 0,
- );
- while ( my ($pattern, $license, $osi) = splice(@phrases, 0, 3) ) {
- $pattern =~ s{\s+}{\\s+}g;
- if ( $license_text =~ /\b$pattern\b/i ) {
- if ( $osi and $license_text =~ /All rights reserved/i ) {
- print "WARNING: 'All rights reserved' in copyright may invalidate Open Source license.\n";
- }
- $self->license($license);
- return 1;
- }
+ return $self->{values}->{license} unless @_;
+ my $license = shift or die(
+ 'Did not provide a value to license()'
+ );
+ $license = __extract_license($license) || lc $license;
+ $self->{values}->{license} = $license;
+
+ # Automatically fill in license URLs
+ if ( $license_urls{$license} ) {
+ $self->resources( license => $license_urls{$license} );
+ }
+
+ return 1;
+}
+
+sub _extract_license {
+ my $pod = shift;
+ my $matched;
+ return __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ L(?i:ICEN[CS]E|ICENSING)\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ ) || __extract_license(
+ ($matched) = $pod =~ m/
+ (=head \d \s+ (?:C(?i:OPYRIGHTS?)|L(?i:EGAL))\b.*?)
+ (=head \d.*|=cut.*|)\z
+ /xms
+ );
+}
+
+sub __extract_license {
+ my $license_text = shift or return;
+ my @phrases = (
+ '(?:under )?the same (?:terms|license) as (?:perl|the perl (?:\d )?programming language)' => 'perl', 1,
+ '(?:under )?the terms of (?:perl|the perl programming language) itself' => 'perl', 1,
+ 'Artistic and GPL' => 'perl', 1,
+ 'GNU general public license' => 'gpl', 1,
+ 'GNU public license' => 'gpl', 1,
+ 'GNU lesser general public license' => 'lgpl', 1,
+ 'GNU lesser public license' => 'lgpl', 1,
+ 'GNU library general public license' => 'lgpl', 1,
+ 'GNU library public license' => 'lgpl', 1,
+ 'GNU Free Documentation license' => 'unrestricted', 1,
+ 'GNU Affero General Public License' => 'open_source', 1,
+ '(?:Free)?BSD license' => 'bsd', 1,
+ 'Artistic license 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';
+ }
+}
- 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 = $content =~ m/L\<(http\:\/\/rt\.cpan\.org\/[^>]+)\>/g;
+ my @links = _extract_bugtracker($content);
unless ( @links ) {
warn "Cannot determine bugtracker info from $_[0]\n";
return 0;
}
if ( @links > 1 ) {
- warn "Found more than on rt.cpan.org link in $_[0]\n";
+ warn "Found more than one bugtracker link in $_[0]\n";
return 0;
}
@@ -469,19 +585,138 @@ sub bugtracker_from {
return 1;
}
-sub install_script {
+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;
- my $args = $self->makemaker_args;
- my $exe = $args->{EXE_FILES} ||= [];
- foreach ( @_ ) {
- if ( -f $_ ) {
- push @$exe, $_;
- } elsif ( -d 'script' and -f "script/$_" ) {
- push @$exe, "script/$_";
- } else {
- die("Cannot find script '$_'");
+
+ # 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 hashes
+ 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
index 3d89b66..97acf77 100644
--- a/inc/Module/Install/RTx.pm
+++ b/inc/Module/Install/RTx.pm
@@ -8,95 +8,91 @@ no warnings 'once';
use Module::Install::Base;
use base 'Module::Install::Base';
-our $VERSION = '0.21';
+our $VERSION = '0.37';
use FindBin;
use File::Glob ();
use File::Basename ();
+my @DIRS = qw(etc lib html static bin sbin po var);
+my @INDEX_DIRS = qw(lib bin sbin);
+
sub RTx {
- my ( $self, $name ) = @_;
+ my ( $self, $name, $extra_args ) = @_;
+ $extra_args ||= {};
- my $original_name = $name;
- my $RTx = 'RTx';
- $RTx = $1 if $name =~ s/^(\w+)-//;
+ # Set up names
my $fname = $name;
$fname =~ s!-!/!g;
- $self->name("$RTx-$name")
+ $self->name( $name )
unless $self->name;
- $self->all_from( -e "$name.pm" ? "$name.pm" : "lib/$RTx/$fname.pm" )
+ $self->all_from( "lib/$fname.pm" )
unless $self->version;
- $self->abstract("RT $name Extension")
+ $self->abstract("$name Extension")
unless $self->abstract;
+ unless ( $extra_args->{no_readme_generation} ) {
+ $self->readme_from( "lib/$fname.pm",
+ { options => [ quotes => "none" ] } );
+ }
+ $self->add_metadata("x_module_install_rtx_version", $VERSION );
- my @prefixes = (qw(/opt /usr/local /home /usr /sw ));
- my $prefix = $ENV{PREFIX};
- @ARGV = grep { /PREFIX=(.*)/ ? ( ( $prefix = $1 ), 0 ) : 1 } @ARGV;
+ # Try to find RT.pm
+ my @prefixes = qw( /opt /usr/local /home /usr /sw /usr/share/request-tracker4);
+ $ENV{RTHOME} =~ s{/RT\.pm$}{} if defined $ENV{RTHOME};
+ $ENV{RTHOME} =~ s{/lib/?$}{} if defined $ENV{RTHOME};
+ my @try = $ENV{RTHOME} ? ($ENV{RTHOME}, "$ENV{RTHOME}/lib") : ();
+ while (1) {
+ my @look = @INC;
+ unshift @look, grep {defined and -d $_} @try;
+ push @look, grep {defined and -d $_}
+ map { ( "$_/rt4/lib", "$_/lib/rt4", "$_/lib" ) } @prefixes;
+ last if eval {local @INC = @look; require RT; $RT::LocalLibPath};
- if ($prefix) {
- $RT::LocalPath = $prefix;
- $INC{'RT.pm'} = "$RT::LocalPath/lib/RT.pm";
- } else {
- local @INC = (
- @INC,
- $ENV{RTHOME} ? ( $ENV{RTHOME}, "$ENV{RTHOME}/lib" ) : (),
- map { ( "$_/rt3/lib", "$_/lib/rt3", "$_/lib" ) } grep $_,
- @prefixes
- );
- until ( eval { require RT; $RT::LocalPath } ) {
- warn
- "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @INC\n";
- $_ = $self->prompt("Path to your RT.pm:") or exit;
- push @INC, $_, "$_/rt3/lib", "$_/lib/rt3", "$_/lib";
- }
+ warn
+ "Cannot find the location of RT.pm that defines \$RT::LocalPath in: @look\n";
+ my $given = $self->prompt("Path to directory containing your RT.pm:") or exit;
+ $given =~ s{/RT\.pm$}{};
+ $given =~ s{/lib/?$}{};
+ @try = ($given, "$given/lib");
}
- my $lib_path = File::Basename::dirname( $INC{'RT.pm'} );
print "Using RT configuration from $INC{'RT.pm'}:\n";
- $RT::LocalVarPath ||= $RT::VarPath;
- $RT::LocalPoPath ||= $RT::LocalLexiconPath;
- $RT::LocalHtmlPath ||= $RT::MasonComponentRoot;
+ my $local_lib_path = $RT::LocalLibPath;
+ unshift @INC, $local_lib_path;
+ my $lib_path = File::Basename::dirname( $INC{'RT.pm'} );
+ unshift @INC, $lib_path;
- my %path;
- 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;
-
- foreach (qw(bin etc html po sbin var)) {
- next unless -d "$FindBin::Bin/$_";
- next if %subdirs and !$subdirs{$_};
- $self->no_index( directory => $_ );
-
- no strict 'refs';
- my $varname = "RT::Local" . ucfirst($_) . "Path";
- $path{$_} = ${$varname} || "$RT::LocalPath/$_";
- }
-
- $path{$_} .= "/$name" for grep $path{$_}, qw(etc po var);
- $path{lib} = "$RT::LocalPath/lib" unless %subdirs and !$subdirs{'lib'};
-
- # 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
- if ($RT::LocalPluginPath) {
- foreach my $path (qw(lib po html etc bin sbin)) {
- next unless -d "$FindBin::Bin/$path";
- next if %subdirs and !$subdirs{$path};
- $path{$path} = $RT::LocalPluginPath . "/$original_name/$path";
- }
+ # Set a baseline minimum version
+ unless ( $extra_args->{deprecated_rt} ) {
+ $self->requires_rt('4.0.0');
}
- my $args = join( ', ', map "q($_)", %path );
- print "./$_\t=> $path{$_}\n" for sort keys %path;
+ # Installation locations
+ my %path;
+ $path{$_} = $RT::LocalPluginPath . "/$name/$_"
+ foreach @DIRS;
+
+ # Copy RT 4.2.0 static files into NoAuth; insufficient for
+ # images, but good enough for css and js.
+ $path{static} = "$path{html}/NoAuth/"
+ unless $RT::StaticPath;
+
+ # Delete the ones we don't need
+ delete $path{$_} for grep {not -d "$FindBin::Bin/$_"} keys %path;
+
+ my %index = map { $_ => 1 } @INDEX_DIRS;
+ $self->no_index( directory => $_ ) foreach grep !$index{$_}, @DIRS;
+
+ my $args = join ', ', map "q($_)", map { ($_, $path{$_}) }
+ sort keys %path;
- if ( my @dirs = map { ( -D => $_ ) } grep $path{$_}, qw(bin html sbin) ) {
- my @po = map { ( -o => $_ ) } grep -f,
+ printf "%-10s => %s\n", $_, $path{$_} for sort keys %path;
+
+ if ( my @dirs = map { ( -D => $_ ) } grep $path{$_}, qw(bin html sbin etc) ) {
+ my @po = map { ( -o => $_ ) }
+ grep -f,
File::Glob::bsd_glob("po/*.po");
$self->postamble(<< ".") if @po;
lexicons ::
@@ -104,8 +100,11 @@ lexicons ::
.
}
+ $self->include('Module::Install::RTx::Runtime') if $self->admin;
+ $self->include_deps( 'YAML::Tiny', 0 ) if $self->admin;
my $postamble = << ".";
install ::
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxPlugin()"
\t\$(NOECHO) \$(PERL) -MExtUtils::Install -e \"install({$args})\"
.
@@ -118,64 +117,145 @@ 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"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name))"
-
-dropdb ::
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxFactory(qw($RTx $name drop))"
-
-.
}
if ( File::Glob::bsd_glob("$FindBin::Bin/etc/acl.*") ) {
$has_etc{acl}++;
}
if ( -e 'etc/initialdata' ) { $has_etc{initialdata}++; }
+ if ( grep { /\d+\.\d+\.\d+.*$/ } glob('etc/upgrade/*.*.*') ) {
+ $has_etc{upgrade}++;
+ }
$self->postamble("$postamble\n");
- if ( %subdirs and !$subdirs{'lib'} ) {
- $self->makemaker_args( PM => { "" => "" }, );
+ if ( $path{lib} ) {
+ $self->makemaker_args( INSTALLSITELIB => $path{'lib'} );
+ $self->makemaker_args( INSTALLARCHLIB => $path{'lib'} );
} else {
- $self->makemaker_args( INSTALLSITELIB => "$RT::LocalPath/lib" );
+ $self->makemaker_args( PM => { "" => "" }, );
}
- $self->makemaker_args( INSTALLSITEMAN1DIR => "$RT::LocalPath/man/man1" );
- $self->makemaker_args( INSTALLSITEMAN3DIR => "$RT::LocalPath/man/man3" );
- $self->makemaker_args( INSTALLSITEARCH => "$RT::LocalPath/man" );
- $self->makemaker_args( INSTALLARCHLIB => "$RT::LocalPath/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"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(schema))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(schema \$(NAME) \$(VERSION)))"
.
$initdb .= <<"." if $has_etc{acl};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(acl))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(acl \$(NAME) \$(VERSION)))"
.
$initdb .= <<"." if $has_etc{initialdata};
-\t\$(NOECHO) \$(PERL) -Ilib -I"$lib_path" -Minc::Module::Install -e"RTxInitDB(qw(insert))"
+\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(insert \$(NAME) \$(VERSION)))"
.
$self->postamble("initdb ::\n$initdb\n");
$self->postamble("initialize-database ::\n$initdb\n");
+ if ($has_etc{upgrade}) {
+ print "To upgrade from a previous version of this extension, use 'make upgrade-database'\n";
+ my $upgradedb = qq|\t\$(NOECHO) \$(PERL) -Ilib -I"$local_lib_path" -I"$lib_path" -Iinc -MModule::Install::RTx::Runtime -e"RTxDatabase(qw(upgrade \$(NAME) \$(VERSION)))"\n|;
+ $self->postamble("upgrade-database ::\n$upgradedb\n");
+ $self->postamble("upgradedb ::\n$upgradedb\n");
+ }
}
+
}
-sub RTxInit {
- unshift @INC, substr( delete( $INC{'RT.pm'} ), 0, -5 ) if $INC{'RT.pm'};
- require RT;
- RT::LoadConfig();
- RT::ConnectToDatabase();
+sub requires_rt {
+ my ($self,$version) = @_;
+
+ _load_rt_handle();
- die "Cannot load RT" unless $RT::Handle and $RT::DatabaseType;
+ if ($self->is_admin) {
+ $self->add_metadata("x_requires_rt", $version);
+ my @sorted = sort RT::Handle::cmp_version $version,'4.0.0';
+ $self->perl_version('5.008003') if $sorted[0] eq '4.0.0'
+ and (not $self->perl_version or '5.008003' > $self->perl_version);
+ @sorted = sort RT::Handle::cmp_version $version,'4.2.0';
+ $self->perl_version('5.010001') if $sorted[0] eq '4.2.0'
+ and (not $self->perl_version or '5.010001' > $self->perl_version);
+ }
+
+ # if we're exactly the same version as what we want, silently return
+ return if ($version eq $RT::VERSION);
+
+ my @sorted = sort RT::Handle::cmp_version $version,$RT::VERSION;
+
+ if ($sorted[-1] eq $version) {
+ die <<"EOT";
+
+**** Error: This extension requires RT $version. Your installed version
+ of RT ($RT::VERSION) is too old.
+
+EOT
+ }
+}
+
+sub requires_rt_plugin {
+ my $self = shift;
+ my ( $plugin ) = @_;
+
+ if ($self->is_admin) {
+ my $plugins = $self->Meta->{values}{"x_requires_rt_plugins"} || [];
+ push @{$plugins}, $plugin;
+ $self->add_metadata("x_requires_rt_plugins", $plugins);
+ }
+
+ my $path = $plugin;
+ $path =~ s{\:\:}{-}g;
+ $path = "$RT::LocalPluginPath/$path/lib";
+ if ( -e $path ) {
+ unshift @INC, $path;
+ } else {
+ my $name = $self->name;
+ warn <<"EOT";
+
+**** Warning: $name requires that the $plugin plugin be installed and
+ enabled; it does not appear to be installed.
+
+EOT
+ }
+ $self->requires(@_);
+}
+
+sub rt_too_new {
+ my ($self,$version,$msg) = @_;
+ my $name = $self->name;
+ $msg ||= <<EOT;
+
+**** Error: Your installed version of RT (%s) is too new; this extension
+ only works with versions older than %s.
+
+EOT
+ $self->add_metadata("x_rt_too_new", $version) if $self->is_admin;
+
+ _load_rt_handle();
+ my @sorted = sort RT::Handle::cmp_version $version,$RT::VERSION;
+
+ if ($sorted[0] eq $version) {
+ die sprintf($msg,$RT::VERSION,$version);
+ }
+}
+
+# RT::Handle runs FinalizeDatabaseType which calls RT->Config->Get
+# On 3.8, this dies. On 4.0/4.2 ->Config transparently runs LoadConfig.
+# LoadConfig requires being able to read RT_SiteConfig.pm (root) so we'd
+# like to avoid pushing that on users.
+# Fake up just enough Config to let FinalizeDatabaseType finish, and
+# anyone later calling LoadConfig will overwrite our shenanigans.
+sub _load_rt_handle {
+ unless ($RT::Config) {
+ require RT::Config;
+ $RT::Config = RT::Config->new;
+ RT->Config->Set('DatabaseType','mysql');
+ }
+ require RT::Handle;
}
1;
__END__
-#line 279
+#line 390
diff --git a/inc/Module/Install/RTx/Runtime.pm b/inc/Module/Install/RTx/Runtime.pm
new file mode 100644
index 0000000..937949f
--- /dev/null
+++ b/inc/Module/Install/RTx/Runtime.pm
@@ -0,0 +1,79 @@
+#line 1
+package Module::Install::RTx::Runtime;
+
+use base 'Exporter';
+our @EXPORT = qw/RTxDatabase RTxPlugin/;
+
+use strict;
+use File::Basename ();
+
+sub _rt_runtime_load {
+ require RT;
+
+ eval { RT::LoadConfig(); };
+ if (my $err = $@) {
+ die $err unless $err =~ /^RT couldn't load RT config file/m;
+ my $warn = <<EOT;
+This usually means that your current user cannot read the file. You
+will likely need to run this installation step as root, or some user
+with more permissions.
+EOT
+ $err =~ s/This usually means.*/$warn/s;
+ die $err;
+ }
+}
+
+sub RTxDatabase {
+ my ($action, $name, $version) = @_;
+
+ _rt_runtime_load();
+
+ require RT::System;
+ my $has_upgrade = RT::System->can('AddUpgradeHistory');
+
+ my $lib_path = File::Basename::dirname($INC{'RT.pm'});
+ my @args = (
+ "-Ilib",
+ "-I$RT::LocalLibPath",
+ "-I$lib_path",
+ "$RT::SbinPath/rt-setup-database",
+ "--action" => $action,
+ ($action eq 'upgrade' ? () : ("--datadir" => "etc")),
+ (($action eq 'insert') ? ("--datafile" => "etc/initialdata") : ()),
+ "--dba" => $RT::DatabaseAdmin || $RT::DatabaseUser,
+ "--prompt-for-dba-password" => '',
+ ($has_upgrade ? ("--package" => $name, "--ext-version" => $version) : ()),
+ );
+ # If we're upgrading against an RT which isn't at least 4.2 (has
+ # AddUpgradeHistory) then pass --package. Upgrades against later RT
+ # releases will pick up --package from AddUpgradeHistory.
+ if ($action eq 'upgrade' and not $has_upgrade) {
+ push @args, "--package" => $name;
+ }
+
+ print "$^X @args\n";
+ (system($^X, @args) == 0) or die "...returned with error: $?\n";
+}
+
+sub RTxPlugin {
+ my ($name) = @_;
+
+ _rt_runtime_load();
+ require YAML::Tiny;
+ my $data = YAML::Tiny::LoadFile('META.yml');
+ my $name = $data->{name};
+
+ my @enabled = RT->Config->Get('Plugins');
+ for my $required (@{$data->{x_requires_rt_plugins} || []}) {
+ next if grep {$required eq $_} @enabled;
+
+ warn <<"EOT";
+
+**** Warning: $name requires that the $required plugin be installed and
+ enabled; it is not currently in \@Plugins.
+
+EOT
+ }
+}
+
+1;
diff --git a/inc/Module/Install/ReadmeFromPod.pm b/inc/Module/Install/ReadmeFromPod.pm
new file mode 100644
index 0000000..b5e03c3
--- /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.22';
+
+sub readme_from {
+ my $self = shift;
+ return unless $self->is_admin;
+
+ # Input file
+ my $in_file = shift || $self->_all_from
+ or die "Can't determine file to make readme_from";
+
+ # Get optional arguments
+ my ($clean, $format, $out_file, $options);
+ my $args = shift;
+ if ( ref $args ) {
+ # Arguments are in a hashref
+ if ( ref($args) ne 'HASH' ) {
+ die "Expected a hashref but got a ".ref($args)."\n";
+ } else {
+ $clean = $args->{'clean'};
+ $format = $args->{'format'};
+ $out_file = $args->{'output_file'};
+ $options = $args->{'options'};
+ }
+ } else {
+ # Arguments are in a list
+ $clean = $args;
+ $format = shift;
+ $out_file = shift;
+ $options = \@_;
+ }
+
+ # Default values;
+ $clean ||= 0;
+ $format ||= 'txt';
+
+ # Generate README
+ print "readme_from $in_file to $format\n";
+ if ($format =~ m/te?xt/) {
+ $out_file = $self->_readme_txt($in_file, $out_file, $options);
+ } elsif ($format =~ m/html?/) {
+ $out_file = $self->_readme_htm($in_file, $out_file, $options);
+ } elsif ($format eq 'man') {
+ $out_file = $self->_readme_man($in_file, $out_file, $options);
+ } elsif ($format eq 'pdf') {
+ $out_file = $self->_readme_pdf($in_file, $out_file, $options);
+ }
+
+ if ($clean) {
+ $self->clean_files($out_file);
+ }
+
+ return 1;
+}
+
+
+sub _readme_txt {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README';
+ require Pod::Text;
+ my $parser = Pod::Text->new( @$options );
+ open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
+ $parser->output_fh( *$out_fh );
+ $parser->parse_file( $in_file );
+ close $out_fh;
+ return $out_file;
+}
+
+
+sub _readme_htm {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.htm';
+ require Pod::Html;
+ Pod::Html::pod2html(
+ "--infile=$in_file",
+ "--outfile=$out_file",
+ @$options,
+ );
+ # Remove temporary files if needed
+ for my $file ('pod2htmd.tmp', 'pod2htmi.tmp') {
+ if (-e $file) {
+ unlink $file or warn "Warning: Could not remove file '$file'.\n$!\n";
+ }
+ }
+ return $out_file;
+}
+
+
+sub _readme_man {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.1';
+ require Pod::Man;
+ my $parser = Pod::Man->new( @$options );
+ $parser->parse_from_file($in_file, $out_file);
+ return $out_file;
+}
+
+
+sub _readme_pdf {
+ my ($self, $in_file, $out_file, $options) = @_;
+ $out_file ||= 'README.pdf';
+ eval { require App::pod2pdf; }
+ or die "Could not generate $out_file because pod2pdf could not be found\n";
+ my $parser = App::pod2pdf->new( @$options );
+ $parser->parse_from_file($in_file);
+ open my $out_fh, '>', $out_file or die "Could not write file $out_file:\n$!\n";
+ select $out_fh;
+ $parser->output;
+ select STDOUT;
+ close $out_fh;
+ return $out_file;
+}
+
+
+sub _all_from {
+ my $self = shift;
+ return unless $self->admin->{extensions};
+ my ($metadata) = grep {
+ ref($_) eq 'Module::Install::Metadata';
+ } @{$self->admin->{extensions}};
+ return unless $metadata;
+ return $metadata->{values}{all_from} || '';
+}
+
+'Readme!';
+
+__END__
+
+#line 254
+
diff --git a/inc/Module/Install/Win32.pm b/inc/Module/Install/Win32.pm
index f890074..218a66b 100644
--- a/inc/Module/Install/Win32.pm
+++ b/inc/Module/Install/Win32.pm
@@ -2,12 +2,12 @@
package Module::Install::Win32;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.76';
- @ISA = qw{Module::Install::Base};
+ $VERSION = '1.16';
+ @ISA = 'Module::Install::Base';
$ISCORE = 1;
}
diff --git a/inc/Module/Install/WriteAll.pm b/inc/Module/Install/WriteAll.pm
index a50d31e..530749b 100644
--- a/inc/Module/Install/WriteAll.pm
+++ b/inc/Module/Install/WriteAll.pm
@@ -2,11 +2,11 @@
package Module::Install::WriteAll;
use strict;
-use Module::Install::Base;
+use Module::Install::Base ();
use vars qw{$VERSION @ISA $ISCORE};
BEGIN {
- $VERSION = '0.76';
+ $VERSION = '1.16';
@ISA = qw{Module::Install::Base};
$ISCORE = 1;
}
@@ -22,19 +22,42 @@ sub WriteAll {
);
$self->sign(1) if $args{sign};
- $self->Meta->write if $args{meta};
$self->admin->WriteAll(%args) if $self->is_admin;
$self->check_nmake if $args{check_nmake};
unless ( $self->makemaker_args->{PL_FILES} ) {
- $self->makemaker_args( PL_FILES => {} );
+ # XXX: This still may be a bit over-defensive...
+ unless ($self->makemaker(6.25)) {
+ $self->makemaker_args( PL_FILES => {} ) if -f 'Build.PL';
+ }
}
+ # Until ExtUtils::MakeMaker support MYMETA.yml, make sure
+ # 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;
diff --git a/inc/YAML/Tiny.pm b/inc/YAML/Tiny.pm
new file mode 100644
index 0000000..aa539f7
--- /dev/null
+++ b/inc/YAML/Tiny.pm
@@ -0,0 +1,874 @@
+#line 1
+use 5.008001; # sane UTF-8 support
+use strict;
+use warnings;
+package YAML::Tiny; # git description: v1.68-2-gcc5324e
+# XXX-INGY is 5.8.1 too old/broken for utf8?
+# XXX-XDG Lancaster consensus was that it was sufficient until
+# proven otherwise
+
+our $VERSION = '1.69';
+
+#####################################################################
+# The YAML::Tiny API.
+#
+# These are the currently documented API functions/methods and
+# exports:
+
+use Exporter;
+our @ISA = qw{ Exporter };
+our @EXPORT = qw{ Load Dump };
+our @EXPORT_OK = qw{ LoadFile DumpFile freeze thaw };
+
+###
+# Functional/Export API:
+
+sub Dump {
+ return YAML::Tiny->new(@_)->_dump_string;
+}
+
+# XXX-INGY Returning last document seems a bad behavior.
+# XXX-XDG I think first would seem more natural, but I don't know
+# that it's worth changing now
+sub Load {
+ my $self = YAML::Tiny->_load_string(@_);
+ if ( wantarray ) {
+ return @$self;
+ } else {
+ # To match YAML.pm, return the last document
+ return $self->[-1];
+ }
+}
+
+# XXX-INGY Do we really need freeze and thaw?
+# XXX-XDG I don't think so. I'd support deprecating them.
+BEGIN {
+ *freeze = \&Dump;
+ *thaw = \&Load;
+}
+
+sub DumpFile {
+ my $file = shift;
+ return YAML::Tiny->new(@_)->_dump_file($file);
+}
+
+sub LoadFile {
+ my $file = shift;
+ my $self = YAML::Tiny->_load_file($file);
+ if ( wantarray ) {
+ return @$self;
+ } else {
+ # Return only the last document to match YAML.pm,
+ return $self->[-1];
+ }
+}
+
+
+###
+# Object Oriented API:
+
+# Create an empty YAML::Tiny object
+# XXX-INGY Why do we use ARRAY object?
+# NOTE: I get it now, but I think it's confusing and not needed.
+# Will change it on a branch later, for review.
+#
+# XXX-XDG I don't support changing it yet. It's a very well-documented
+# "API" of YAML::Tiny. I'd support deprecating it, but Adam suggested
+# we not change it until YAML.pm's own OO API is established so that
+# users only have one API change to digest, not two
+sub new {
+ my $class = shift;
+ bless [ @_ ], $class;
+}
+
+# XXX-INGY It probably doesn't matter, and it's probably too late to
+# change, but 'read/write' are the wrong names. Read and Write
+# are actions that take data from storage to memory
+# characters/strings. These take the data to/from storage to native
+# Perl objects, which the terms dump and load are meant. As long as
+# this is a legacy quirk to YAML::Tiny it's ok, but I'd prefer not
+# to add new {read,write}_* methods to this API.
+
+sub read_string {
+ my $self = shift;
+ $self->_load_string(@_);
+}
+
+sub write_string {
+ my $self = shift;
+ $self->_dump_string(@_);
+}
+
+sub read {
+ my $self = shift;
+ $self->_load_file(@_);
+}
+
+sub write {
+ my $self = shift;
+ $self->_dump_file(@_);
+}
+
+
+
+
+#####################################################################
+# Constants
+
+# Printed form of the unprintable characters in the lowest range
+# of ASCII characters, listed by ASCII ordinal position.
+my @UNPRINTABLE = qw(
+ 0 x01 x02 x03 x04 x05 x06 a
+ b t n v f r x0E x0F
+ x10 x11 x12 x13 x14 x15 x16 x17
+ x18 x19 x1A e x1C x1D x1E x1F
+);
+
+# Printable characters for escapes
+my %UNESCAPES = (
+ 0 => "\x00", z => "\x00", N => "\x85",
+ a => "\x07", b => "\x08", t => "\x09",
+ n => "\x0a", v => "\x0b", f => "\x0c",
+ r => "\x0d", e => "\x1b", '\\' => '\\',
+);
+
+# XXX-INGY
+# I(ngy) need to decide if these values should be quoted in
+# YAML::Tiny or not. Probably yes.
+
+# These 3 values have special meaning when unquoted and using the
+# default YAML schema. They need quotes if they are strings.
+my %QUOTE = map { $_ => 1 } qw{
+ null true false
+};
+
+# The commented out form is simpler, but overloaded the Perl regex
+# engine due to recursion and backtracking problems on strings
+# larger than 32,000ish characters. Keep it for reference purposes.
+# qr/\"((?:\\.|[^\"])*)\"/
+my $re_capture_double_quoted = qr/\"([^\\"]*(?:\\.[^\\"]*)*)\"/;
+my $re_capture_single_quoted = qr/\'([^\']*(?:\'\'[^\']*)*)\'/;
+# unquoted re gets trailing space that needs to be stripped
+my $re_capture_unquoted_key = qr/([^:]+(?::+\S(?:[^:]*|.*?(?=:)))*)(?=\s*\:(?:\s+|$))/;
+my $re_trailing_comment = qr/(?:\s+\#.*)?/;
+my $re_key_value_separator = qr/\s*:(?:\s+(?:\#.*)?|$)/;
+
+
+
+
+
+#####################################################################
+# YAML::Tiny Implementation.
+#
+# These are the private methods that do all the work. They may change
+# at any time.
+
+
+###
+# Loader functions:
+
+# Create an object from a file
+sub _load_file {
+ my $class = ref $_[0] ? ref shift : shift;
+
+ # Check the file
+ my $file = shift or $class->_error( 'You did not specify a file name' );
+ $class->_error( "File '$file' does not exist" )
+ unless -e $file;
+ $class->_error( "'$file' is a directory, not a file" )
+ unless -f _;
+ $class->_error( "Insufficient permissions to read '$file'" )
+ unless -r _;
+
+ # Open unbuffered with strict UTF-8 decoding and no translation layers
+ open( my $fh, "<:unix:encoding(UTF-8)", $file );
+ unless ( $fh ) {
+ $class->_error("Failed to open file '$file': $!");
+ }
+
+ # flock if available (or warn if not possible for OS-specific reasons)
+ if ( _can_flock() ) {
+ flock( $fh, Fcntl::LOCK_SH() )
+ or warn "Couldn't lock '$file' for reading: $!";
+ }
+
+ # slurp the contents
+ my $contents = eval {
+ use warnings FATAL => 'utf8';
+ local $/;
+ <$fh>
+ };
+ if ( my $err = $@ ) {
+ $class->_error("Error reading from file '$file': $err");
+ }
+
+ # close the file (release the lock)
+ unless ( close $fh ) {
+ $class->_error("Failed to close file '$file': $!");
+ }
+
+ $class->_load_string( $contents );
+}
+
+# Create an object from a string
+sub _load_string {
+ my $class = ref $_[0] ? ref shift : shift;
+ my $self = bless [], $class;
+ my $string = $_[0];
+ eval {
+ unless ( defined $string ) {
+ die \"Did not provide a string to load";
+ }
+
+ # Check if Perl has it marked as characters, but it's internally
+ # inconsistent. E.g. maybe latin1 got read on a :utf8 layer
+ if ( utf8::is_utf8($string) && ! utf8::valid($string) ) {
+ die \<<'...';
+Read an invalid UTF-8 string (maybe mixed UTF-8 and 8-bit character set).
+Did you decode with lax ":utf8" instead of strict ":encoding(UTF-8)"?
+...
+ }
+
+ # Ensure Unicode character semantics, even for 0x80-0xff
+ utf8::upgrade($string);
+
+ # Check for and strip any leading UTF-8 BOM
+ $string =~ s/^\x{FEFF}//;
+
+ # Check for some special cases
+ return $self unless length $string;
+
+ # Split the file into lines
+ my @lines = grep { ! /^\s*(?:\#.*)?\z/ }
+ split /(?:\015{1,2}\012|\015|\012)/, $string;
+
+ # Strip the initial YAML header
+ @lines and $lines[0] =~ /^\%YAML[: ][\d\.]+.*\z/ and shift @lines;
+
+ # A nibbling parser
+ my $in_document = 0;
+ while ( @lines ) {
+ # Do we have a document header?
+ if ( $lines[0] =~ /^---\s*(?:(.+)\s*)?\z/ ) {
+ # Handle scalar documents
+ shift @lines;
+ if ( defined $1 and $1 !~ /^(?:\#.+|\%YAML[: ][\d\.]+)\z/ ) {
+ push @$self,
+ $self->_load_scalar( "$1", [ undef ], \@lines );
+ next;
+ }
+ $in_document = 1;
+ }
+
+ if ( ! @lines or $lines[0] =~ /^(?:---|\.\.\.)/ ) {
+ # A naked document
+ push @$self, undef;
+ while ( @lines and $lines[0] !~ /^---/ ) {
+ shift @lines;
+ }
+ $in_document = 0;
+
+ # XXX The final '-+$' is to look for -- which ends up being an
+ # error later.
+ } elsif ( ! $in_document && @$self ) {
+ # only the first document can be explicit
+ die \"YAML::Tiny failed to classify the line '$lines[0]'";
+ } elsif ( $lines[0] =~ /^\s*\-(?:\s|$|-+$)/ ) {
+ # An array at the root
+ my $document = [ ];
+ push @$self, $document;
+ $self->_load_array( $document, [ 0 ], \@lines );
+
+ } elsif ( $lines[0] =~ /^(\s*)\S/ ) {
+ # A hash at the root
+ my $document = { };
+ push @$self, $document;
+ $self->_load_hash( $document, [ length($1) ], \@lines );
+
+ } else {
+ # Shouldn't get here. @lines have whitespace-only lines
+ # stripped, and previous match is a line with any
+ # non-whitespace. So this clause should only be reachable via
+ # a perlbug where \s is not symmetric with \S
+
+ # uncoverable statement
+ die \"YAML::Tiny failed to classify the line '$lines[0]'";
+ }
+ }
+ };
+ my $err = $@;
+ if ( ref $err eq 'SCALAR' ) {
+ $self->_error(${$err});
+ } elsif ( $err ) {
+ $self->_error($err);
+ }
+
+ return $self;
+}
+
+sub _unquote_single {
+ my ($self, $string) = @_;
+ return '' unless length $string;
+ $string =~ s/\'\'/\'/g;
+ return $string;
+}
+
+sub _unquote_double {
+ my ($self, $string) = @_;
+ return '' unless length $string;
+ $string =~ s/\\"/"/g;
+ $string =~
+ s{\\([Nnever\\fartz0b]|x([0-9a-fA-F]{2}))}
+ {(length($1)>1)?pack("H2",$2):$UNESCAPES{$1}}gex;
+ return $string;
+}
+
+# Load a YAML scalar string to the actual Perl scalar
+sub _load_scalar {
+ my ($self, $string, $indent, $lines) = @_;
+
+ # Trim trailing whitespace
+ $string =~ s/\s*\z//;
+
+ # Explitic null/undef
+ return undef if $string eq '~';
+
+ # Single quote
+ if ( $string =~ /^$re_capture_single_quoted$re_trailing_comment\z/ ) {
+ return $self->_unquote_single($1);
+ }
+
+ # Double quote.
+ if ( $string =~ /^$re_capture_double_quoted$re_trailing_comment\z/ ) {
+ return $self->_unquote_double($1);
+ }
+
+ # Special cases
+ if ( $string =~ /^[\'\"!&]/ ) {
+ die \"YAML::Tiny does not support a feature in line '$string'";
+ }
+ return {} if $string =~ /^{}(?:\s+\#.*)?\z/;
+ return [] if $string =~ /^\[\](?:\s+\#.*)?\z/;
+
+ # Regular unquoted string
+ if ( $string !~ /^[>|]/ ) {
+ die \"YAML::Tiny found illegal characters in plain scalar: '$string'"
+ if $string =~ /^(?:-(?:\s|$)|[\@\%\`])/ or
+ $string =~ /:(?:\s|$)/;
+ $string =~ s/\s+#.*\z//;
+ return $string;
+ }
+
+ # Error
+ die \"YAML::Tiny failed to find multi-line scalar content" unless @$lines;
+
+ # Check the indent depth
+ $lines->[0] =~ /^(\s*)/;
+ $indent->[-1] = length("$1");
+ if ( defined $indent->[-2] and $indent->[-1] <= $indent->[-2] ) {
+ die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
+ }
+
+ # Pull the lines
+ my @multiline = ();
+ while ( @$lines ) {
+ $lines->[0] =~ /^(\s*)/;
+ last unless length($1) >= $indent->[-1];
+ push @multiline, substr(shift(@$lines), length($1));
+ }
+
+ my $j = (substr($string, 0, 1) eq '>') ? ' ' : "\n";
+ my $t = (substr($string, 1, 1) eq '-') ? '' : "\n";
+ return join( $j, @multiline ) . $t;
+}
+
+# Load an array
+sub _load_array {
+ my ($self, $array, $indent, $lines) = @_;
+
+ while ( @$lines ) {
+ # Check for a new document
+ if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
+ while ( @$lines and $lines->[0] !~ /^---/ ) {
+ shift @$lines;
+ }
+ return 1;
+ }
+
+ # Check the indent level
+ $lines->[0] =~ /^(\s*)/;
+ if ( length($1) < $indent->[-1] ) {
+ return 1;
+ } elsif ( length($1) > $indent->[-1] ) {
+ die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
+ }
+
+ if ( $lines->[0] =~ /^(\s*\-\s+)[^\'\"]\S*\s*:(?:\s+|$)/ ) {
+ # Inline nested hash
+ my $indent2 = length("$1");
+ $lines->[0] =~ s/-/ /;
+ push @$array, { };
+ $self->_load_hash( $array->[-1], [ @$indent, $indent2 ], $lines );
+
+ } elsif ( $lines->[0] =~ /^\s*\-\s*\z/ ) {
+ shift @$lines;
+ unless ( @$lines ) {
+ push @$array, undef;
+ return 1;
+ }
+ if ( $lines->[0] =~ /^(\s*)\-/ ) {
+ my $indent2 = length("$1");
+ if ( $indent->[-1] == $indent2 ) {
+ # Null array entry
+ push @$array, undef;
+ } else {
+ # Naked indenter
+ push @$array, [ ];
+ $self->_load_array(
+ $array->[-1], [ @$indent, $indent2 ], $lines
+ );
+ }
+
+ } elsif ( $lines->[0] =~ /^(\s*)\S/ ) {
+ push @$array, { };
+ $self->_load_hash(
+ $array->[-1], [ @$indent, length("$1") ], $lines
+ );
+
+ } else {
+ die \"YAML::Tiny failed to classify line '$lines->[0]'";
+ }
+
+ } elsif ( $lines->[0] =~ /^\s*\-(\s*)(.+?)\s*\z/ ) {
+ # Array entry with a value
+ shift @$lines;
+ push @$array, $self->_load_scalar(
+ "$2", [ @$indent, undef ], $lines
+ );
+
+ } elsif ( defined $indent->[-2] and $indent->[-1] == $indent->[-2] ) {
+ # This is probably a structure like the following...
+ # ---
+ # foo:
+ # - list
+ # bar: value
+ #
+ # ... so lets return and let the hash parser handle it
+ return 1;
+
+ } else {
+ die \"YAML::Tiny failed to classify line '$lines->[0]'";
+ }
+ }
+
+ return 1;
+}
+
+# Load a hash
+sub _load_hash {
+ my ($self, $hash, $indent, $lines) = @_;
+
+ while ( @$lines ) {
+ # Check for a new document
+ if ( $lines->[0] =~ /^(?:---|\.\.\.)/ ) {
+ while ( @$lines and $lines->[0] !~ /^---/ ) {
+ shift @$lines;
+ }
+ return 1;
+ }
+
+ # Check the indent level
+ $lines->[0] =~ /^(\s*)/;
+ if ( length($1) < $indent->[-1] ) {
+ return 1;
+ } elsif ( length($1) > $indent->[-1] ) {
+ die \"YAML::Tiny found bad indenting in line '$lines->[0]'";
+ }
+
+ # Find the key
+ my $key;
+
+ # Quoted keys
+ if ( $lines->[0] =~
+ s/^\s*$re_capture_single_quoted$re_key_value_separator//
+ ) {
+ $key = $self->_unquote_single($1);
+ }
+ elsif ( $lines->[0] =~
+ s/^\s*$re_capture_double_quoted$re_key_value_separator//
+ ) {
+ $key = $self->_unquote_double($1);
+ }
+ elsif ( $lines->[0] =~
+ s/^\s*$re_capture_unquoted_key$re_key_value_separator//
+ ) {
+ $key = $1;
+ $key =~ s/\s+$//;
+ }
+ elsif ( $lines->[0] =~ /^\s*\?/ ) {
+ die \"YAML::Tiny does not support a feature in line '$lines->[0]'";
+ }
+ else {
+ die \"YAML::Tiny failed to classify line '$lines->[0]'";
+ }
+
+ if ( exists $hash->{$key} ) {
+ warn "YAML::Tiny found a duplicate key '$key' in line '$lines->[0]'";
+ }
+
+ # Do we have a value?
+ if ( length $lines->[0] ) {
+ # Yes
+ $hash->{$key} = $self->_load_scalar(
+ shift(@$lines), [ @$indent, undef ], $lines
+ );
+ } else {
+ # An indent
+ shift @$lines;
+ unless ( @$lines ) {
+ $hash->{$key} = undef;
+ return 1;
+ }
+ if ( $lines->[0] =~ /^(\s*)-/ ) {
+ $hash->{$key} = [];
+ $self->_load_array(
+ $hash->{$key}, [ @$indent, length($1) ], $lines
+ );
+ } elsif ( $lines->[0] =~ /^(\s*)./ ) {
+ my $indent2 = length("$1");
+ if ( $indent->[-1] >= $indent2 ) {
+ # Null hash entry
+ $hash->{$key} = undef;
+ } else {
+ $hash->{$key} = {};
+ $self->_load_hash(
+ $hash->{$key}, [ @$indent, length($1) ], $lines
+ );
+ }
+ }
+ }
+ }
+
+ return 1;
+}
+
+
+###
+# Dumper functions:
+
+# Save an object to a file
+sub _dump_file {
+ my $self = shift;
+
+ require Fcntl;
+
+ # Check the file
+ my $file = shift or $self->_error( 'You did not specify a file name' );
+
+ my $fh;
+ # flock if available (or warn if not possible for OS-specific reasons)
+ if ( _can_flock() ) {
+ # Open without truncation (truncate comes after lock)
+ my $flags = Fcntl::O_WRONLY()|Fcntl::O_CREAT();
+ sysopen( $fh, $file, $flags );
+ unless ( $fh ) {
+ $self->_error("Failed to open file '$file' for writing: $!");
+ }
+
+ # Use no translation and strict UTF-8
+ binmode( $fh, ":raw:encoding(UTF-8)");
+
+ flock( $fh, Fcntl::LOCK_EX() )
+ or warn "Couldn't lock '$file' for reading: $!";
+
+ # truncate and spew contents
+ truncate $fh, 0;
+ seek $fh, 0, 0;
+ }
+ else {
+ open $fh, ">:unix:encoding(UTF-8)", $file;
+ }
+
+ # serialize and spew to the handle
+ print {$fh} $self->_dump_string;
+
+ # close the file (release the lock)
+ unless ( close $fh ) {
+ $self->_error("Failed to close file '$file': $!");
+ }
+
+ return 1;
+}
+
+# Save an object to a string
+sub _dump_string {
+ my $self = shift;
+ return '' unless ref $self && @$self;
+
+ # Iterate over the documents
+ my $indent = 0;
+ my @lines = ();
+
+ eval {
+ foreach my $cursor ( @$self ) {
+ push @lines, '---';
+
+ # An empty document
+ if ( ! defined $cursor ) {
+ # Do nothing
+
+ # A scalar document
+ } elsif ( ! ref $cursor ) {
+ $lines[-1] .= ' ' . $self->_dump_scalar( $cursor );
+
+ # A list at the root
+ } elsif ( ref $cursor eq 'ARRAY' ) {
+ unless ( @$cursor ) {
+ $lines[-1] .= ' []';
+ next;
+ }
+ push @lines, $self->_dump_array( $cursor, $indent, {} );
+
+ # A hash at the root
+ } elsif ( ref $cursor eq 'HASH' ) {
+ unless ( %$cursor ) {
+ $lines[-1] .= ' {}';
+ next;
+ }
+ push @lines, $self->_dump_hash( $cursor, $indent, {} );
+
+ } else {
+ die \("Cannot serialize " . ref($cursor));
+ }
+ }
+ };
+ if ( ref $@ eq 'SCALAR' ) {
+ $self->_error(${$@});
+ } elsif ( $@ ) {
+ $self->_error($@);
+ }
+
+ join '', map { "$_\n" } @lines;
+}
+
+sub _has_internal_string_value {
+ my $value = shift;
+ my $b_obj = B::svref_2object(\$value); # for round trip problem
+ return $b_obj->FLAGS & B::SVf_POK();
+}
+
+sub _dump_scalar {
+ my $string = $_[1];
+ my $is_key = $_[2];
+ # Check this before checking length or it winds up looking like a string!
+ my $has_string_flag = _has_internal_string_value($string);
+ return '~' unless defined $string;
+ return "''" unless length $string;
+ if (Scalar::Util::looks_like_number($string)) {
+ # keys and values that have been used as strings get quoted
+ if ( $is_key || $has_string_flag ) {
+ return qq['$string'];
+ }
+ else {
+ return $string;
+ }
+ }
+ if ( $string =~ /[\x00-\x09\x0b-\x0d\x0e-\x1f\x7f-\x9f\'\n]/ ) {
+ $string =~ s/\\/\\\\/g;
+ $string =~ s/"/\\"/g;
+ $string =~ s/\n/\\n/g;
+ $string =~ s/[\x85]/\\N/g;
+ $string =~ s/([\x00-\x1f])/\\$UNPRINTABLE[ord($1)]/g;
+ $string =~ s/([\x7f-\x9f])/'\x' . sprintf("%X",ord($1))/ge;
+ return qq|"$string"|;
+ }
+ if ( $string =~ /(?:^[~!@#%&*|>?:,'"`{}\[\]]|^-+$|\s|:\z)/ or
+ $QUOTE{$string}
+ ) {
+ return "'$string'";
+ }
+ return $string;
+}
+
+sub _dump_array {
+ my ($self, $array, $indent, $seen) = @_;
+ if ( $seen->{refaddr($array)}++ ) {
+ die \"YAML::Tiny does not support circular references";
+ }
+ my @lines = ();
+ foreach my $el ( @$array ) {
+ my $line = (' ' x $indent) . '-';
+ my $type = ref $el;
+ if ( ! $type ) {
+ $line .= ' ' . $self->_dump_scalar( $el );
+ push @lines, $line;
+
+ } elsif ( $type eq 'ARRAY' ) {
+ if ( @$el ) {
+ push @lines, $line;
+ push @lines, $self->_dump_array( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' []';
+ push @lines, $line;
+ }
+
+ } elsif ( $type eq 'HASH' ) {
+ if ( keys %$el ) {
+ push @lines, $line;
+ push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' {}';
+ push @lines, $line;
+ }
+
+ } else {
+ die \"YAML::Tiny does not support $type references";
+ }
+ }
+
+ @lines;
+}
+
+sub _dump_hash {
+ my ($self, $hash, $indent, $seen) = @_;
+ if ( $seen->{refaddr($hash)}++ ) {
+ die \"YAML::Tiny does not support circular references";
+ }
+ my @lines = ();
+ foreach my $name ( sort keys %$hash ) {
+ my $el = $hash->{$name};
+ my $line = (' ' x $indent) . $self->_dump_scalar($name, 1) . ":";
+ my $type = ref $el;
+ if ( ! $type ) {
+ $line .= ' ' . $self->_dump_scalar( $el );
+ push @lines, $line;
+
+ } elsif ( $type eq 'ARRAY' ) {
+ if ( @$el ) {
+ push @lines, $line;
+ push @lines, $self->_dump_array( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' []';
+ push @lines, $line;
+ }
+
+ } elsif ( $type eq 'HASH' ) {
+ if ( keys %$el ) {
+ push @lines, $line;
+ push @lines, $self->_dump_hash( $el, $indent + 1, $seen );
+ } else {
+ $line .= ' {}';
+ push @lines, $line;
+ }
+
+ } else {
+ die \"YAML::Tiny does not support $type references";
+ }
+ }
+
+ @lines;
+}
+
+
+
+#####################################################################
+# DEPRECATED API methods:
+
+# Error storage (DEPRECATED as of 1.57)
+our $errstr = '';
+
+# Set error
+sub _error {
+ require Carp;
+ $errstr = $_[1];
+ $errstr =~ s/ at \S+ line \d+.*//;
+ Carp::croak( $errstr );
+}
+
+# Retrieve error
+my $errstr_warned;
+sub errstr {
+ require Carp;
+ Carp::carp( "YAML::Tiny->errstr and \$YAML::Tiny::errstr is deprecated" )
+ unless $errstr_warned++;
+ $errstr;
+}
+
+
+
+
+#####################################################################
+# Helper functions. Possibly not needed.
+
+
+# Use to detect nv or iv
+use B;
+
+# XXX-INGY Is flock YAML::Tiny's responsibility?
+# Some platforms can't flock :-(
+# XXX-XDG I think it is. When reading and writing files, we ought
+# to be locking whenever possible. People (foolishly) use YAML
+# files for things like session storage, which has race issues.
+my $HAS_FLOCK;
+sub _can_flock {
+ if ( defined $HAS_FLOCK ) {
+ return $HAS_FLOCK;
+ }
+ else {
+ require Config;
+ my $c = \%Config::Config;
+ $HAS_FLOCK = grep { $c->{$_} } qw/d_flock d_fcntl_can_lock d_lockf/;
+ require Fcntl if $HAS_FLOCK;
+ return $HAS_FLOCK;
+ }
+}
+
+
+# XXX-INGY Is this core in 5.8.1? Can we remove this?
+# XXX-XDG Scalar::Util 1.18 didn't land until 5.8.8, so we need this
+#####################################################################
+# Use Scalar::Util if possible, otherwise emulate it
+
+use Scalar::Util ();
+BEGIN {
+ local $@;
+ if ( eval { Scalar::Util->VERSION(1.18); } ) {
+ *refaddr = *Scalar::Util::refaddr;
+ }
+ else {
+ eval <<'END_PERL';
+# Scalar::Util failed to load or too old
+sub refaddr {
+ my $pkg = ref($_[0]) or return undef;
+ if ( !! UNIVERSAL::can($_[0], 'can') ) {
+ bless $_[0], 'Scalar::Util::Fake';
+ } else {
+ $pkg = undef;
+ }
+ "$_[0]" =~ /0x(\w+)/;
+ my $i = do { no warnings 'portable'; hex $1 };
+ bless $_[0], $pkg if defined $pkg;
+ $i;
+}
+END_PERL
+ }
+}
+
+delete $YAML::Tiny::{refaddr};
+
+1;
+
+# XXX-INGY Doc notes I'm putting up here. Changing the doc when it's wrong
+# but leaving grey area stuff up here.
+#
+# I would like to change Read/Write to Load/Dump below without
+# changing the actual API names.
+#
+# It might be better to put Load/Dump API in the SYNOPSIS instead of the
+# dubious OO API.
+#
+# null and bool explanations may be outdated.
+
+__END__
+
+#line 1489
commit 39454384599dbc1aae5085d66517b8399d1bfba6
Author: Dustin Graves <dustin at bestpractical.com>
Date: Tue May 10 21:39:10 2016 +0000
updated extension module to include documentation
diff --git a/README b/README
index b948dd4..77d1b09 100644
--- a/README
+++ b/README
@@ -1,16 +1,42 @@
-This simple extension for RT 3.x (Tested on 3.4 and newer) adds a dropdown
-of a user's queues into RT's menubar. Using a tiny bit of javascript,
-selecting one of these queues will automatically jump to a search showing
-new, open and stalled tickets in that queue.
+NAME
+ RT::Extension::MenubarSearches - Adds quick queue search to menu
-To install:
+DESCRIPTION
+ This simple extension adds a dropdown of a user's queues into RT's
+ menubar. Using a tiny bit of javascript, selecting one of these queues
+ will automatically jump to a search showing new, open and stalled
+ tickets in that queue.
+INSTALLATION
perl Makefile.PL
+ make
make install
+ May need root permissions
-then add 'RT::Extension::MenubarSearches' to @Plugins in RT_SiteConfig.pm
+ Edit your /opt/rt4/etc/RT_SiteConfig.pm
+ If you are using RT 4.2 or greater, add this line:
-Copyright 2006-2008 Best Practical Solutions, LLC
-No warranty, so on and so forth. Enjoy.
+ Plugin('RT::Extension::MenubarSearches');
+
+ For RT 4.0, add this line:
+
+ Set(@Plugins, qw(RT::Extension::MenubarSearches));
+
+ or add RT::Extension::MenubarSearches to your existing @Plugins
+ line.
+
+ Clear your mason cache
+ rm -rf /opt/rt4/var/mason_data/obj
+
+ Restart your webserver
+
+AUTHOR
+ Best Practical Solutions, LLC <modules at bestpractical.com>
+
+LICENSE AND COPYRIGHT
+ This software is Copyright (c) 2016 by Best Practical Solutions
+
+ This is free software, licensed under:
+
+ The GNU General Public License, Version 2, June 1991
-For help, write to rt-users at lists.bestpractical.com.
diff --git a/lib/RT/Extension/MenubarSearches.pm b/lib/RT/Extension/MenubarSearches.pm
index 3a31d21..59b61e0 100644
--- a/lib/RT/Extension/MenubarSearches.pm
+++ b/lib/RT/Extension/MenubarSearches.pm
@@ -1,8 +1,112 @@
+# BEGIN BPS TAGGED BLOCK {{{
+#
+# COPYRIGHT:
+#
+# This software is Copyright (c) 1996-2014 Best Practical Solutions, LLC
+# <sales at bestpractical.com>
+#
+# (Except where explicitly superseded by other copyright notices)
+#
+#
+# LICENSE:
+#
+# This work is made available to you under the terms of Version 2 of
+# the GNU General Public License. A copy of that license should have
+# been provided with this software, but in any event can be snarfed
+# from www.gnu.org.
+#
+# This work is distributed in the hope that it will be useful, but
+# WITHOUT ANY WARRANTY; without even the implied warranty of
+# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+# General Public License for more details.
+#
+# You should have received a copy of the GNU General Public License
+# along with this program; if not, write to the Free Software
+# Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA
+# 02110-1301 or visit their web page on the internet at
+# http://www.gnu.org/licenses/old-licenses/gpl-2.0.html.
+#
+#
+# CONTRIBUTION SUBMISSION POLICY:
+#
+# (The following paragraph is not intended to limit the rights granted
+# to you to modify and distribute this software under the terms of
+# the GNU General Public License and is only of importance to you if
+# you choose to contribute your changes and enhancements to the
+# community by submitting them to Best Practical Solutions, LLC.)
+#
+# By intentionally submitting any modifications, corrections or
+# derivatives to this work, or any other work intended for use with
+# Request Tracker, to Best Practical Solutions, LLC, you confirm that
+# you are the copyright holder for those contributions and you grant
+# Best Practical Solutions, LLC a nonexclusive, worldwide, irrevocable,
+# royalty-free, perpetual, license to use, copy, create derivative
+# works based on those contributions, and sublicense and distribute
+# those contributions and any derivatives thereof.
+#
+# END BPS TAGGED BLOCK }}}
+package RT::Extension::MenuBarSearches;
+
+our $VERSION = '0.06';
+
use warnings;
use strict;
-package RT::Extension::MenuBarSearches;
+=head1 NAME
-our $VERSION = '0.06';
+RT::Extension::MenubarSearches - Adds quick queue search to menu
+
+=head1 DESCRIPTION
+
+This simple extension adds a dropdown of a user's queues into RT's menubar.
+Using a tiny bit of javascript, selecting one of these queues will
+automatically jump to a search showing new, open and stalled tickets in that
+queue.
+
+=head1 INSTALLATION
+
+=over
+
+=item C<perl Makefile.PL>
+
+=item C<make>
+
+=item C<make install>
+
+May need root permissions
+
+=item Edit your F</opt/rt4/etc/RT_SiteConfig.pm>
+
+If you are using RT 4.2 or greater, add this line:
+
+ Plugin('RT::Extension::MenubarSearches');
+
+For RT 4.0, add this line:
+
+ Set(@Plugins, qw(RT::Extension::MenubarSearches));
+
+or add C<RT::Extension::MenubarSearches> to your existing C<@Plugins> line.
+
+=item Clear your mason cache
+
+ rm -rf /opt/rt4/var/mason_data/obj
+
+=item Restart your webserver
+
+=back
+
+=head1 AUTHOR
+
+Best Practical Solutions, LLC E<lt>modules at bestpractical.comE<gt>
+
+=head1 LICENSE AND COPYRIGHT
+
+This software is Copyright (c) 2016 by Best Practical Solutions
+
+This is free software, licensed under:
+
+ The GNU General Public License, Version 2, June 1991
+
+=cut
1;
commit 912f339c8e8012f3c80ecd85a3947fd393e7918c
Author: Dustin Graves <dustin at bestpractical.com>
Date: Tue May 10 21:39:34 2016 +0000
incremented version to 0.07
diff --git a/META.yml b/META.yml
index ac859a7..15f8016 100644
--- a/META.yml
+++ b/META.yml
@@ -20,6 +20,6 @@ requires:
perl: 5.8.3
resources:
license: http://dev.perl.org/licenses/
-version: '0.06'
+version: '0.07'
x_module_install_rtx_version: '0.37'
x_requires_rt: 4.0.0
diff --git a/lib/RT/Extension/MenubarSearches.pm b/lib/RT/Extension/MenubarSearches.pm
index 59b61e0..d28a3c2 100644
--- a/lib/RT/Extension/MenubarSearches.pm
+++ b/lib/RT/Extension/MenubarSearches.pm
@@ -47,7 +47,7 @@
# END BPS TAGGED BLOCK }}}
package RT::Extension::MenuBarSearches;
-our $VERSION = '0.06';
+our $VERSION = '0.07';
use warnings;
use strict;
-----------------------------------------------------------------------
More information about the Bps-public-commit
mailing list