[Rt-commit] rt branch, 4.6/cpanfile, created. rt-4.4.1-115-g8782803

Alex Vandiver alexmv at bestpractical.com
Sat Jul 23 22:22:24 EDT 2016


The branch, 4.6/cpanfile has been created
        at  8782803df56fceb367c6f25af604df36d2084ead (commit)

- Log -----------------------------------------------------------------
commit a6e7e054dcb3ed211693339d5e9ba150683ed79a
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sat Jun 4 14:21:56 2016 -0700

    Store dependencies in cpanfile
    
    Previously, dependencies were stored in a complicated hash for unclear
    reasons, and traversed in random order.  Additionally, the
    specification of them included unwieldy boilerplate and here-docs.
    
    Switch to storing the dependency list in a `cpanfile`, and load it by
    stubbing the small number of functions to produce a useful
    datastructure.  This switches the format to the more expressive '>='
    and '!=' syntax used in META.yml[1] files, condensing the "AVOID"
    list away.
    
    Because at least one of the database "features" is always required,
    installing directly via `cpanm --install-deps .` is not suggested or
    documented at this time.  Using the `cpanfile` format, however, opens
    the door to using `carton` and similar toolchains to manage
    dependencies.
    
    [1] https://metacpan.org/pod/CPAN::Meta::Spec#Version-Ranges

diff --git a/Makefile.in b/Makefile.in
index 4efc2ee..a57c073 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -169,6 +169,7 @@ ETC_FILES		=	acl.Pg \
 				schema.Oracle \
 				schema.mysql \
 				schema.SQLite \
+				cpanfile \
 				initialdata
 
 
diff --git a/etc/cpanfile b/etc/cpanfile
new file mode 100644
index 0000000..2e5d0c4
--- /dev/null
+++ b/etc/cpanfile
@@ -0,0 +1,206 @@
+# Core dependencies
+requires 'Apache::Session', '>= 1.53';
+requires 'Business::Hours';
+requires 'CGI', ($] >= 5.019003 ? '>= 4.00' : '>= 3.38');
+requires 'CGI::Cookie', '>= 1.20';
+requires 'CGI::Emulate::PSGI';
+requires 'CGI::PSGI', '>= 0.12';
+requires 'Class::Accessor::Fast';
+requires 'Convert::Color';
+requires 'Crypt::Eksblowfish';
+requires 'CSS::Minifier::XS';
+requires 'CSS::Squish', '>= 0.06';
+requires 'Data::GUID';
+requires 'Data::ICal';
+requires 'Data::Page::Pageset';
+requires 'Date::Extract', '>= 0.02';
+requires 'Date::Manip';
+requires 'DateTime', '>= 0.44';
+requires 'DateTime::Format::Natural', '>= 0.67';
+requires 'DateTime::Locale', '>= 0.40, != 1.00, != 1.01';
+requires 'DBI', '>= 1.37';
+requires 'DBIx::SearchBuilder', '>= 1.65';
+requires 'Devel::GlobalDestruction';
+requires 'Devel::StackTrace', '>= 1.19, != 1.28, != 1.29';
+requires 'Digest::base';
+requires 'Digest::MD5', '>= 2.27';
+requires 'Digest::SHA';
+requires 'Email::Address', '>= 1.897';
+requires 'Email::Address::List', '>= 0.02';
+requires 'Encode', '>= 2.64';
+requires 'Errno';
+requires 'File::Glob';
+requires 'File::ShareDir';
+requires 'File::Spec', '>= 0.8';
+requires 'File::Temp', '>= 0.19';
+requires 'HTML::Entities';
+requires 'HTML::FormatText::WithLinks', '>= 0.14';
+requires 'HTML::FormatText::WithLinks::AndTables', '>= 0.06';
+requires 'HTML::Mason', '>= 1.43';
+requires 'HTML::Mason::PSGIHandler', '>= 0.52';
+requires 'HTML::Quoted';
+requires 'HTML::RewriteAttributes', '>= 0.05';
+requires 'HTML::Scrubber', '>= 0.08';
+requires 'HTTP::Message', '>= 6.0';
+requires 'IPC::Run3';
+requires 'JavaScript::Minifier::XS';
+requires 'JSON';
+requires 'List::MoreUtils';
+requires 'Locale::Maketext', '>= 1.06';
+requires 'Locale::Maketext::Fuzzy', '>= 0.11';
+requires 'Locale::Maketext::Lexicon', '>= 0.32';
+requires 'Log::Dispatch', '>= 2.30';
+requires 'LWP::Simple';
+requires 'Mail::Header', '>= 2.12';
+requires 'Mail::Mailer', '>= 1.57';
+requires 'MIME::Entity', '>= 5.504';
+requires 'MIME::Types';
+requires 'Module::Refresh', '>= 0.03';
+requires 'Module::Versions::Report', '>= 1.05';
+requires 'Net::CIDR';
+requires 'Net::IP';
+requires 'Plack', '>= 1.0002';
+requires 'Plack::Handler::Starlet';
+requires 'Pod::Select';
+requires 'Regexp::Common';
+requires 'Regexp::Common::net::CIDR';
+requires 'Regexp::IPv6';
+requires 'Role::Basic', '>= 0.12';
+requires 'Scalar::Util';
+requires 'Scope::Upper';
+requires 'Storable', '>= 2.08';
+requires 'Symbol::Global::Name', ($] >= 5.019003 ? '>= 0.05' : '>= 0.04');
+requires 'Sys::Syslog', '>= 0.16';
+requires 'Text::Password::Pronounceable';
+requires 'Text::Quoted', '>= 2.07';
+requires 'Text::Template', '>= 1.44';
+requires 'Text::WikiFormat', '>= 0.76';
+requires 'Text::Wrapper';
+requires 'Time::HiRes';
+requires 'Time::ParseDate';
+requires 'Tree::Simple', '>= 1.04';
+requires 'UNIVERSAL::require';
+requires 'URI', '>= 1.59';
+requires 'URI::QueryParam';
+requires 'XML::RSS', '>= 1.05';
+
+# Mailgate
+requires 'Crypt::SSLeay';
+requires 'Getopt::Long';
+requires 'LWP::Protocol::https';
+requires 'LWP::UserAgent', '>= 6.0';
+requires 'Mozilla::CA';
+requires 'Net::SSL';
+requires 'Pod::Usage';
+
+# CLI
+requires 'Getopt::Long', '>= 2.24';
+requires 'HTTP::Request::Common';
+requires 'LWP';
+requires 'Term::ReadKey';
+requires 'Term::ReadLine';
+requires 'Text::ParseWords';
+
+
+on 'develop' => sub {
+    requires 'Email::Abstract';
+    requires 'File::Find';
+    requires 'File::Which';
+    requires 'HTML::Entities';
+    requires 'Locale::PO';
+    requires 'Log::Dispatch::Perl';
+    requires 'Mojo::DOM';
+    requires 'Plack::Middleware::Test::StashWarnings', '>= 0.08';
+    requires 'Pod::Simple', '>= 3.24';
+    requires 'Set::Tiny';
+    requires 'String::ShellQuote';
+    requires 'Test::Builder', '>= 0.90';
+    requires 'Test::Deep';
+    requires 'Test::Email';
+    requires 'Test::Expect', '>= 0.31';
+    requires 'Test::LongString';
+    requires 'Test::MockTime';
+    requires 'Test::NoWarnings';
+    requires 'Test::Pod';
+    requires 'Test::Warn';
+    requires 'Test::WWW::Mechanize', '>= 1.30';
+    requires 'Test::WWW::Mechanize::PSGI';
+    requires 'WWW::Mechanize', '>= 1.52';
+    requires 'XML::Simple';
+};
+
+
+# Deployment options
+feature 'standalone' => sub {};
+
+feature 'fastcgi' => sub {
+    requires 'FCGI', '>= 0.74';
+};
+
+feature 'modperl1' => sub {
+    requires 'Apache::Request';
+};
+
+feature 'modperl2' => sub {};
+
+
+# Database options
+feature 'mysql' => sub {
+    requires 'DBD::mysql', '>= 2.1018';
+};
+
+feature 'oracle' => sub {
+    requires 'DBD::Oracle != 1.23';
+};
+
+feature 'pg' => sub {
+    requires 'DBIx::SearchBuilder', '>= 1.66';
+    requires 'DBD::Pg', '>= 1.43';
+};
+
+feature 'sqlite' => sub {
+    requires 'DBD::SQLite', '>= 1.00';
+};
+
+
+# Optional features
+feature 'gpg' => sub {
+    requires 'File::Which';
+    requires 'GnuPG::Interface';
+    requires 'PerlIO::eol';
+};
+
+feature 'smime' => sub {
+    requires 'Crypt::X509';
+    requires 'File::Which';
+    requires 'String::ShellQuote';
+};
+
+feature 'graphviz' => sub {
+    requires 'GraphViz';
+    requires 'IPC::Run', '>= 0.90';
+};
+
+feature 'gd' => sub {
+    requires 'GD';
+    requires 'GD::Graph', '>= 1.47';
+    requires 'GD::Text';
+};
+
+feature 'externalauth' => sub {
+    requires 'Net::SSLeay';
+    requires 'Net::LDAP';
+    on 'develop' => sub {
+        requires 'Net::LDAP::Server::Test';
+    };
+};
+
+
+# External attachment storage
+feature 's3' => sub {
+    requires 'Amazon::S3';
+};
+
+feature 'dropbox' => sub {
+    requires 'File::Dropbox';
+};
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index 0e57ca1..e0813c5 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -46,22 +46,19 @@
 # those contributions and any derivatives thereof.
 #
 # END BPS TAGGED BLOCK }}}
-#
-# This is just a basic script that checks to make sure that all
-# the modules needed by RT before you can install it.
-#
 
 use strict;
 use warnings;
-no warnings qw(numeric redefine);
+
 use Getopt::Long;
+
 use Cwd qw(abs_path);
-my %args;
-my %deps;
+use File::Spec;
 my @orig_argv = @ARGV;
 # Save our path because installers or tests can change cwd
 my $script_path = abs_path($0);
 
+my %args;
 GetOptions(
     \%args,
     'install!',
@@ -109,231 +106,27 @@ $args{$_} = $default{$_} foreach grep {!exists $args{$_}} keys %default;
 $args{'with-EXTERNALAUTH-TESTS'}
     = $args{'with-EXTERNALAUTH'} && $args{'with-DEVELOPER'};
 
-$deps{'CORE'} = [ text_to_hash( << '.') ];
-Apache::Session 1.53
-Business::Hours
-CGI 3.38
-CGI::Cookie 1.20
-CGI::Emulate::PSGI
-CGI::PSGI 0.12
-Class::Accessor::Fast
-Convert::Color
-Crypt::Eksblowfish
-CSS::Minifier::XS
-CSS::Squish 0.06
-Data::GUID
-Data::ICal
-Data::Page::Pageset
-Date::Extract 0.02
-Date::Manip
-DateTime 0.44
-DateTime::Format::Natural 0.67
-DateTime::Locale 0.40
-DBI 1.37
-DBIx::SearchBuilder 1.65
-Devel::GlobalDestruction
-Devel::StackTrace 1.19
-Digest::base
-Digest::MD5 2.27
-Digest::SHA
-Email::Address 1.897
-Email::Address::List 0.02
-Encode 2.64
-Errno
-File::Glob
-File::ShareDir
-File::Spec 0.8
-File::Temp 0.19
-HTML::Entities
-HTML::FormatText::WithLinks 0.14
-HTML::FormatText::WithLinks::AndTables 0.06
-HTML::Mason 1.43
-HTML::Mason::PSGIHandler 0.52
-HTML::Quoted
-HTML::RewriteAttributes 0.05
-HTML::Scrubber 0.08
-HTTP::Message 6.0
-IPC::Run3
-JavaScript::Minifier::XS
-JSON
-List::MoreUtils
-Locale::Maketext 1.06
-Locale::Maketext::Fuzzy 0.11
-Locale::Maketext::Lexicon 0.32
-Log::Dispatch 2.30
-LWP::Simple
-Mail::Header 2.12
-Mail::Mailer 1.57
-MIME::Entity 5.504
-MIME::Types
-Module::Refresh 0.03
-Module::Versions::Report 1.05
-Net::CIDR
-Net::IP
-Plack 1.0002
-Plack::Handler::Starlet
-Pod::Select
-Regexp::Common
-Regexp::Common::net::CIDR
-Regexp::IPv6
-Role::Basic 0.12
-Scalar::Util
-Scope::Upper
-Storable 2.08
-Symbol::Global::Name 0.04
-Sys::Syslog 0.16
-Text::Password::Pronounceable
-Text::Quoted 2.07
-Text::Template 1.44
-Text::WikiFormat 0.76
-Text::Wrapper
-Time::HiRes
-Time::ParseDate
-Tree::Simple 1.04
-UNIVERSAL::require
-URI 1.59
-URI::QueryParam
-XML::RSS 1.05
-.
-set_dep( CORE => 'Symbol::Global::Name' => 0.05 ) if $] >= 5.019003;
-set_dep( CORE => CGI => 4.00 ) if $] > 5.019003;
-
-$deps{'MAILGATE'} = [ text_to_hash( << '.') ];
-Crypt::SSLeay
-Getopt::Long
-LWP::Protocol::https
-LWP::UserAgent 6.0
-Mozilla::CA
-Net::SSL
-Pod::Usage
-.
-
-$deps{'CLI'} = [ text_to_hash( << '.') ];
-Getopt::Long 2.24
-HTTP::Request::Common
-LWP
-Term::ReadKey
-Term::ReadLine
-Text::ParseWords
-.
-
-$deps{'DEVELOPER'} = [ text_to_hash( << '.') ];
-Email::Abstract
-File::Find
-File::Which
-HTML::Entities
-Locale::PO
-Log::Dispatch::Perl
-Mojo::DOM
-Plack::Middleware::Test::StashWarnings 0.08
-Pod::Simple 3.24
-Set::Tiny
-String::ShellQuote 0 # needed for gnupg-incoming.t
-Test::Builder 0.90 # needed for is_passing
-Test::Deep 0 # needed for shredder tests
-Test::Email
-Test::Expect 0.31
-Test::LongString
-Test::MockTime
-Test::NoWarnings
-Test::Pod
-Test::Warn
-Test::WWW::Mechanize 1.30
-Test::WWW::Mechanize::PSGI
-WWW::Mechanize 1.52
-XML::Simple
-.
-
-$deps{'FASTCGI'} = [ text_to_hash( << '.') ];
-FCGI 0.74
-.
-
-$deps{'MODPERL1'} = [ text_to_hash( << '.') ];
-Apache::Request
-.
-
-$deps{'MYSQL'} = [ text_to_hash( << '.') ];
-DBD::mysql 2.1018
-.
-
-$deps{'ORACLE'} = [ text_to_hash( << '.') ];
-DBD::Oracle
-.
-
-$deps{'PG'} = [ text_to_hash( << '.') ];
-DBIx::SearchBuilder 1.66
-DBD::Pg 1.43
-.
-
-$deps{'SQLITE'} = [ text_to_hash( << '.') ];
-DBD::SQLite 1.00
-.
-
-$deps{'GPG'} = [ text_to_hash( << '.') ];
-File::Which
-GnuPG::Interface
-PerlIO::eol
-.
-
-$deps{'SMIME'} = [ text_to_hash( << '.') ];
-Crypt::X509
-File::Which
-String::ShellQuote
-.
-
-$deps{'GRAPHVIZ'} = [ text_to_hash( << '.') ];
-GraphViz
-IPC::Run 0.90
-.
-
-$deps{'GD'} = [ text_to_hash( << '.') ];
-GD
-GD::Graph 1.47
-GD::Text
-.
-
-$deps{'EXTERNALAUTH'} = [ text_to_hash( <<'.') ];
-Net::SSLeay
-Net::LDAP
-.
-
-$deps{'EXTERNALAUTH-TESTS'} = [ text_to_hash( <<'.') ];
-Net::LDAP::Server::Test
-.
-
-$deps{'S3'} = [ text_to_hash( <<'.') ];
-Amazon::S3
-.
-
-$deps{'DROPBOX'} = [ text_to_hash( <<'.') ];
-File::Dropbox
-.
-
-my %AVOID = (
-    'DBD::Oracle'       => [qw(1.23)],
-    'Devel::StackTrace' => [qw(1.28 1.29)],
-    'DateTime::Locale'  => [qw(1.00 1.01)]
-);
-
+my %deps = read_deps();
 check_perl_version();
 
 check_users();
 
-my %Missing_By_Type = ();
-foreach my $type ( sort grep {$args{$_}} keys %args ) {
-    next unless ( $type =~ /^with-(.*?)$/ ) and $deps{$1};
+test_deps();
 
-    $type = $1;
-    section("$type dependencies");
+if ($args{'install'}) {
+    for my $type ( sort keys %deps ) {
+        for my $module (sort keys %{$deps{$type}}) {
+            # Recheck if the dependency is now satisfied, either
+            # because it was pulled in as part of some other install,
+            # or if it was failing to load because of bad deps.
+            next if test_dep( $module, $deps{$type}{$module} );
 
-    my @missing;
-    my @deps = @{ $deps{$type} };
+            resolve_dep( $module );
 
-    my %missing = test_deps(@deps);
-
-    if ( $args{'install'} ) {
-        for my $module ( keys %missing ) {
-            resolve_dep( $module, $missing{$module}{version} );
+            # Delete the module and reload it; if it was previously
+            # installed and got upgraded, this means the new version
+            # will get loaded if some later module goes looking for it
+            # as a prereq.
             my $m = $module . '.pm';
             $m =~ s!::!/!g;
             if ( delete $INC{$m} ) {
@@ -344,19 +137,18 @@ foreach my $type ( sort grep {$args{$_}} keys %args ) {
                     delete $symtab->{$symbol};
                 }
             }
-            delete $missing{$module}
-                if test_dep( $module, $missing{$module}{version}, $AVOID{$module} );
+
+            # Recheck, to catch install failures and the like
+            delete $deps{$type}{$module} if test_dep( $module, $deps{$type}{$module} );
         }
+        delete $deps{$type} if not keys %{$deps{$type}};
     }
-
-    $Missing_By_Type{$type} = \%missing if keys %missing;
+    exec( $script_path, @orig_argv, '--no-install' ) if %deps;
 }
 
-if ( $args{'install'} && keys %Missing_By_Type ) {
-    exec( $script_path, @orig_argv, '--no-install' );
-} else {
-    conclude(%Missing_By_Type);
-}
+conclude();
+exit 0;
+
 
 sub section {
     my $s = shift;
@@ -376,26 +168,21 @@ sub print_found {
 }
 
 sub conclude {
-    my %missing_by_type = @_;
-
-    unless ( keys %missing_by_type ) {
+    unless ( keys %deps ) {
         print "\nAll dependencies have been found.\n";
         return;
     }
 
     print "\nSOME DEPENDENCIES WERE MISSING.\n";
 
-    for my $type ( keys %missing_by_type ) {
-        my $missing = $missing_by_type{$type};
-
+    foreach my $type ( sort keys %deps ) {
         print "$type missing dependencies:\n";
-        for my $name ( keys %$missing ) {
-            my $module  = $missing->{$name};
-            my $version = $module->{version};
-            my $error   = $module->{error};
-            print_found(
-                $name . ( $version && !$error ? " >= $version" : "" ),
-                0, $module->{error} );
+        for my $module (sort keys %{$deps{$type}}) {
+            my $spec = $deps{$type}{$module};
+            my ($ok, $error) = test_dep( $module, $spec );
+            next if $ok;
+            my $msg = $module . ( $spec  && !$error ? " $spec" : "" );
+            print_found( $msg, $ok, $error );
         }
     }
 
@@ -405,73 +192,87 @@ sub conclude {
     exit 1;
 }
 
-sub text_to_hash {
-    my %hash;
-    for my $line ( split /\n/, $_[0] ) {
-        my ( $key, $value ) = $line =~ /(\S+)\s*(\S*)/;
-        $value ||= '';
-        $hash{$key} = $value;
-    }
-
-    return %hash;
-}
-
-sub set_dep {
-    my ( $name, $module, $version ) = @_;
-    my %list = @{ $deps{$name} };
-    $list{$module} = ( $version || '' );
-    $deps{$name} = [%list];
+sub read_deps {
+    my %deps;
+
+    # 'local' would be cleaner, but you can't localize lexicals. :/
+    my @section = ('CORE');
+
+    no warnings 'once';
+    local *requires = sub {
+        $deps{$section[-1]}{$_[0]} = $_[1];
+    };
+    local *on = sub {
+        return unless $_[0] eq 'develop' and $args{'with-DEVELOPER'};
+        push @section, 'DEVELOPER';
+        $_[1]->();
+        pop @section;
+    };
+    local *feature = sub {
+        return unless $args{"with-".uc($_[0])};
+        push @section, uc( $_[0] );
+        $_[-1]->();
+        pop @section;
+    };
+
+    my ($vol, $dir, $path) = File::Spec->splitpath( $script_path );
+    my $ret = do "$dir/../etc/cpanfile";
+    die "Failed to load cpanfile: @{[$@ || $!]}" if not defined $ret and ($@ or $!);
+
+    return %deps;
 }
 
 sub test_deps {
-    my @deps = @_;
-
-    my %missing;
-    while (@deps) {
-        my $module  = shift @deps;
-        my $version = shift @deps;
-        my ( $test, $error ) = test_dep( $module, $version, $AVOID{$module} );
-        my $msg = $module . ( $version && !$error ? " >= $version" : '' );
-        print_found( $msg, $test, $error );
-
-        $missing{$module} = { version => $version, error => $error }
-            unless $test;
+    foreach my $type ( sort keys %deps ) {
+        section("$type dependencies");
+
+        for my $module (sort keys %{$deps{$type}}) {
+            my $spec = $deps{$type}{$module};
+            my ($ok, $error) = test_dep( $module, $spec );
+            my $msg = $module . ( $spec  && !$error ? " $spec" : "" );
+            print_found( $msg, $ok, $error );
+            delete $deps{$type}{$module} if $ok;
+        }
+        delete $deps{$type} if not keys %{$deps{$type}};
+        print "\n";
     }
-
-    return %missing;
 }
 
 sub test_dep {
-    my $module  = shift;
-    my $version = shift;
-    my $avoid   = shift;
+    my ($module, $version_spec) = @_;
+    my @spec_parts = split /\s*,\s*/, defined $version_spec ? $version_spec : '';
+    my @req = grep {defined} map {/>=\s*(\S+)/ ? $1 : undef} @spec_parts;
+    my @avoid = grep {defined} map {/!=\s*(\S+)/ ? $1 : undef} @spec_parts;
+    @req = ('') unless @req;
 
     no warnings 'deprecated';
-    eval "{ local \$ENV{__WARN__}; use $module $version () }";
-    if ( my $error = $@ ) {
-        return 0 unless wantarray;
+    for my $version (@req) {
+        eval "{ local \$ENV{__WARN__}; use $module $version () }";
+        if ( my $error = $@ ) {
+            return 0 unless wantarray;
 
-        $error =~ s/\n(.*)$//s;
-        $error =~ s/at \(eval \d+\) line \d+\.$//;
-        undef $error if $error =~ /this is only/;
+            $error =~ s/\n(.*)$//s;
+            $error =~ s/at \(eval \d+\) line \d+\.$//;
+            undef $error if $error =~ /this is only/;
 
-        my $path = $module;
-        $path =~ s{::}{/}g;
-        undef $error
-            if defined $error
-            and $error =~ /^Can't locate $path\.pm in \@INC/;
+            my $path = $module;
+            $path =~ s{::}{/}g;
+            undef $error
+                if defined $error
+                and $error =~ /^Can't locate $path\.pm in \@INC/;
 
-        return ( 0, $error );
+            return ( 0, $error );
+        }
     }
 
-    if ($avoid) {
-        my $version = $module->VERSION;
-        if ( grep {$version eq $_} @$avoid ) {
-            return 0 unless wantarray;
-            return ( 0,
-                "It's known that there are problems with RT and version '$version' of '$module' module. If it's the latest available version of the module then you have to downgrade manually."
-            );
-        }
+    return 1 unless @avoid;
+
+    my $version = $module->VERSION;
+    if ( grep {$version eq $_} @avoid ) {
+        return 0 unless wantarray;
+        return ( 0,
+                 "It's known that there are problems with RT and version '$version' of '$module' module. If it's the latest available version of the module then you have to downgrade manually."
+             );
     }
 
     return 1;
@@ -535,7 +336,6 @@ END
 
 sub resolve_dep {
     my $module  = shift;
-    my $version = shift;
 
     unless ( defined $args{siteinstall} ) {
         require Config;

commit 52af5d6f3bd7d282302a1f7012ade22ff5568557
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sun Jun 5 11:39:26 2016 -0700

    Move perl version into cpanfile

diff --git a/etc/cpanfile b/etc/cpanfile
index 2e5d0c4..354114f 100644
--- a/etc/cpanfile
+++ b/etc/cpanfile
@@ -1,3 +1,5 @@
+requires 'perl', '5.10.1';
+
 # Core dependencies
 requires 'Apache::Session', '>= 1.53';
 requires 'Business::Hours';
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index e0813c5..ee6b609 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -389,17 +389,18 @@ sub resolve_dep {
 
 sub check_perl_version {
     section("perl");
-    eval { require 5.010_001 };
+    my $require = delete $deps{CORE}{perl};
+    eval "require $require";
     if ($@) {
         print_found(
-            "5.10.1", 0,
+            $require, 0,
             sprintf(
-                "RT requires Perl v5.10.1 or newer. Your current Perl is v%vd",
+                "RT requires Perl v$require or newer. Your current Perl is v%vd",
                 $^V )
         );
         exit(1);
     } else {
-        print_found( sprintf( ">=5.10.1(%vd)", $^V ), 1 );
+        print_found( sprintf( ">=%s(%vd)", $require, $^V ), 1 );
     }
 }
 

commit d4dbf02d93a3620e7f58ce6411f21f1615174896
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sun Jun 5 11:34:41 2016 -0700

    Rename print_found to row
    
    This pairs better with "section", and removes ambiguity about if it
    can be called when a resource was _not_ found.

diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index ee6b609..c4dea2a 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -155,7 +155,7 @@ sub section {
     print "$s:\n";
 }
 
-sub print_found {
+sub row {
     my $msg   = shift;
     my $test  = shift;
     my $extra = shift;
@@ -182,7 +182,7 @@ sub conclude {
             my ($ok, $error) = test_dep( $module, $spec );
             next if $ok;
             my $msg = $module . ( $spec  && !$error ? " $spec" : "" );
-            print_found( $msg, $ok, $error );
+            row( $msg, $ok, $error );
         }
     }
 
@@ -230,7 +230,7 @@ sub test_deps {
             my $spec = $deps{$type}{$module};
             my ($ok, $error) = test_dep( $module, $spec );
             my $msg = $module . ( $spec  && !$error ? " $spec" : "" );
-            print_found( $msg, $ok, $error );
+            row( $msg, $ok, $error );
             delete $deps{$type}{$module} if $ok;
         }
         delete $deps{$type} if not keys %{$deps{$type}};
@@ -392,7 +392,7 @@ sub check_perl_version {
     my $require = delete $deps{CORE}{perl};
     eval "require $require";
     if ($@) {
-        print_found(
+        row(
             $require, 0,
             sprintf(
                 "RT requires Perl v$require or newer. Your current Perl is v%vd",
@@ -400,18 +400,18 @@ sub check_perl_version {
         );
         exit(1);
     } else {
-        print_found( sprintf( ">=%s(%vd)", $require, $^V ), 1 );
+        row( sprintf( ">=%s(%vd)", $require, $^V ), 1 );
     }
 }
 
 sub check_users {
     section("users");
-    print_found( "rt group (@RTGROUP@)",      defined getgrnam("@RTGROUP@") );
-    print_found( "bin owner (@BIN_OWNER@)",   defined getpwnam("@BIN_OWNER@") );
-    print_found( "libs owner (@LIBS_OWNER@)", defined getpwnam("@LIBS_OWNER@") );
-    print_found( "libs group (@LIBS_GROUP@)", defined getgrnam("@LIBS_GROUP@") );
-    print_found( "web owner (@WEB_USER@)",    defined getpwnam("@WEB_USER@") );
-    print_found( "web group (@WEB_GROUP@)",   defined getgrnam("@WEB_GROUP@") );
+    row( "rt group (@RTGROUP@)",      defined getgrnam("@RTGROUP@") );
+    row( "bin owner (@BIN_OWNER@)",   defined getpwnam("@BIN_OWNER@") );
+    row( "libs owner (@LIBS_OWNER@)", defined getpwnam("@LIBS_OWNER@") );
+    row( "libs group (@LIBS_GROUP@)", defined getgrnam("@LIBS_GROUP@") );
+    row( "web owner (@WEB_USER@)",    defined getpwnam("@WEB_USER@") );
+    row( "web group (@WEB_GROUP@)",   defined getgrnam("@WEB_GROUP@") );
 }
 
 1;

commit 7a83e47fa2ced219e602de3de54b3a8344d2eb63
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sun Jun 5 11:39:16 2016 -0700

    Improve horizontal and vertical spacing of output

diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index c4dea2a..21d42de 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -160,23 +160,27 @@ sub row {
     my $test  = shift;
     my $extra = shift;
 
-    print "\t$msg ...";
-    print $test ? "found" : "MISSING";
-    print "\n";
+    my $dots = "." x (55 - (length $msg));
 
-    print "\t\t$extra\n" if defined $extra;
+    if ($test) {
+        print "    $msg $dots ok\n";
+    } else {
+        print "    $msg $dots MISSING\n";
+        print "        $extra\n" if $extra;
+    }
 }
 
 sub conclude {
+    print "\n", "-" x 75, "\n\n";
     unless ( keys %deps ) {
-        print "\nAll dependencies have been found.\n";
+        print "All dependencies found.\n\n";
         return;
     }
 
-    print "\nSOME DEPENDENCIES WERE MISSING.\n";
+    print "SOME DEPENDENCIES WERE MISSING:\n\n";
 
     foreach my $type ( sort keys %deps ) {
-        print "$type missing dependencies:\n";
+        section("$type dependencies");
         for my $module (sort keys %{$deps{$type}}) {
             my $spec = $deps{$type}{$module};
             my ($ok, $error) = test_dep( $module, $spec );
@@ -184,9 +188,10 @@ sub conclude {
             my $msg = $module . ( $spec  && !$error ? " $spec" : "" );
             row( $msg, $ok, $error );
         }
+        print "\n";
     }
 
-    print "\nPerl library path for @PERL@:\n";
+    print "Perl library path for @PERL@:\n";
     print "    $_\n" for @INC;
 
     exit 1;
@@ -402,6 +407,7 @@ sub check_perl_version {
     } else {
         row( sprintf( ">=%s(%vd)", $require, $^V ), 1 );
     }
+    print "\n";
 }
 
 sub check_users {
@@ -412,6 +418,7 @@ sub check_users {
     row( "libs group (@LIBS_GROUP@)", defined getgrnam("@LIBS_GROUP@") );
     row( "web owner (@WEB_USER@)",    defined getpwnam("@WEB_USER@") );
     row( "web group (@WEB_GROUP@)",   defined getgrnam("@WEB_GROUP@") );
+    print "\n";
 }
 
 1;

commit 4afbfd566d4b0ba215b8cd016ea63833b4a7562c
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sat Jun 4 15:22:26 2016 -0700

    Show current version of module, when relevant

diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index 21d42de..9d56282 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -158,14 +158,17 @@ sub section {
 sub row {
     my $msg   = shift;
     my $test  = shift;
+    my $have  = shift;
     my $extra = shift;
 
     my $dots = "." x (55 - (length $msg));
 
     if ($test) {
-        print "    $msg $dots ok\n";
+        $have = $have ? "ok ($have)" : "ok";
+        print "    $msg $dots $have\n";
     } else {
-        print "    $msg $dots MISSING\n";
+        $have = $have ? "MISSING (have $have)" : "MISSING";
+        print "    $msg $dots $have\n";
         print "        $extra\n" if $extra;
     }
 }
@@ -186,7 +189,8 @@ sub conclude {
             my ($ok, $error) = test_dep( $module, $spec );
             next if $ok;
             my $msg = $module . ( $spec  && !$error ? " $spec" : "" );
-            row( $msg, $ok, $error );
+            my $v = $spec && eval { local $SIG{__WARN__}; $module->VERSION };
+            row( $msg, $ok, $v, $error );
         }
         print "\n";
     }
@@ -235,7 +239,8 @@ sub test_deps {
             my $spec = $deps{$type}{$module};
             my ($ok, $error) = test_dep( $module, $spec );
             my $msg = $module . ( $spec  && !$error ? " $spec" : "" );
-            row( $msg, $ok, $error );
+            my $v = $spec && eval { local $SIG{__WARN__}; $module->VERSION };
+            row( $msg, $ok, $v, $error );
             delete $deps{$type}{$module} if $ok;
         }
         delete $deps{$type} if not keys %{$deps{$type}};

commit 080c4ac4007d2290cb2f31d182cc2fe4b9d1de89
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sun Jun 5 11:45:17 2016 -0700

    Use "current value" for perl check as well

diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index 9d56282..4a24ded 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -402,15 +402,10 @@ sub check_perl_version {
     my $require = delete $deps{CORE}{perl};
     eval "require $require";
     if ($@) {
-        row(
-            $require, 0,
-            sprintf(
-                "RT requires Perl v$require or newer. Your current Perl is v%vd",
-                $^V )
-        );
+        row( $require, 0,  sprintf("%vd", $^V ) );
         exit(1);
     } else {
-        row( sprintf( ">=%s(%vd)", $require, $^V ), 1 );
+        row( $require, 1, sprintf( "%vd", $^V ) );
     }
     print "\n";
 }

commit b063b228ce03d44542436993182631a590276b65
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sun Jun 5 11:46:17 2016 -0700

    Use "current value" for user / group display

diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index 4a24ded..17ed6e4 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -412,12 +412,22 @@ sub check_perl_version {
 
 sub check_users {
     section("users");
-    row( "rt group (@RTGROUP@)",      defined getgrnam("@RTGROUP@") );
-    row( "bin owner (@BIN_OWNER@)",   defined getpwnam("@BIN_OWNER@") );
-    row( "libs owner (@LIBS_OWNER@)", defined getpwnam("@LIBS_OWNER@") );
-    row( "libs group (@LIBS_GROUP@)", defined getgrnam("@LIBS_GROUP@") );
-    row( "web owner (@WEB_USER@)",    defined getpwnam("@WEB_USER@") );
-    row( "web group (@WEB_GROUP@)",   defined getgrnam("@WEB_GROUP@") );
+
+    my $line = sub {
+        my ($type, $func, $name, $value) = @_;
+        my $id = $func->($value);
+        my $return_type = substr($type,0,1)."id";
+        row("$name $type ($value)", defined $id, defined $id ? "$return_type $id" : undef);
+    };
+    my $group = sub { $line->("group", sub {getgrnam($_[0])}, @_) };
+    my $user  = sub { $line->("user",  sub {getpwnam($_[0])}, @_) };
+
+    $group->( rt   => "@RTGROUP@" );
+    $user->(  bin  => "@BIN_OWNER@" );
+    $user->(  libs => "@LIBS_OWNER@" );
+    $group->( libs => "@LIBS_GROUP@" );
+    $user->(  web  => "@WEB_USER@" );
+    $group->( web  => "@WEB_GROUP@" );
     print "\n";
 }
 

commit 7eb35c70a5bf93c9effdab64bb290e755772b4e2
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sun Jun 5 11:46:41 2016 -0700

    Rename check_users, since it checks groups as well

diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index 17ed6e4..c343316 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -109,7 +109,7 @@ $args{'with-EXTERNALAUTH-TESTS'}
 my %deps = read_deps();
 check_perl_version();
 
-check_users();
+check_users_groups();
 
 test_deps();
 
@@ -410,8 +410,8 @@ sub check_perl_version {
     print "\n";
 }
 
-sub check_users {
-    section("users");
+sub check_users_groups {
+    section("users / groups");
 
     my $line = sub {
         my ($type, $func, $name, $value) = @_;

commit a1eeb10a73f2d03822052cef5bc998be0b0db833
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sun Jun 5 11:46:58 2016 -0700

    Fail-fast if the users or groups do not check out
    
    Any failures of this information are not re-summarized after modules
    are checked, which may cause it to be lost in the scrollback.
    Additionally, such failures did not cause a failing exit code.
    
    Like the perl version check, abort immediately if there are any
    failures in this section.

diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index c343316..d94838c 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -413,9 +413,11 @@ sub check_perl_version {
 sub check_users_groups {
     section("users / groups");
 
+    my $fails = 0;
     my $line = sub {
         my ($type, $func, $name, $value) = @_;
         my $id = $func->($value);
+        $fails++ unless defined $id;
         my $return_type = substr($type,0,1)."id";
         row("$name $type ($value)", defined $id, defined $id ? "$return_type $id" : undef);
     };
@@ -429,6 +431,7 @@ sub check_users_groups {
     $user->(  web  => "@WEB_USER@" );
     $group->( web  => "@WEB_GROUP@" );
     print "\n";
+    exit 1 if $fails;
 }
 
 1;

commit f2c4c6e6a6598b34f5c9b8f05e5fd8f7395fcf68
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sat Jun 4 14:24:36 2016 -0700

    Show output with colors when run from a terminal

diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index d94838c..fd771ce 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -150,9 +150,15 @@ conclude();
 exit 0;
 
 
+sub grey         { return -t STDOUT ? "\e[1;30m$_[0]\e[0m" : $_[0]; }
+sub bright_blue  { return -t STDOUT ? "\e[1;34m$_[0]\e[0m" : $_[0]; }
+sub green        { return -t STDOUT ? "\e[32m$_[0]\e[0m" : $_[0];   }
+sub bright_green { return -t STDOUT ? "\e[1;32m$_[0]\e[0m" : $_[0]; }
+sub bright_red   { return -t STDOUT ? "\e[1;31m$_[0]\e[0m" : $_[0]; }
+
 sub section {
     my $s = shift;
-    print "$s:\n";
+    print bright_blue("$s:\n");
 }
 
 sub row {
@@ -161,26 +167,26 @@ sub row {
     my $have  = shift;
     my $extra = shift;
 
-    my $dots = "." x (55 - (length $msg));
+    my $dots = grey("." x (55 - (length $msg)));
 
     if ($test) {
-        $have = $have ? "ok ($have)" : "ok";
+        $have = green($have ? "ok ($have)" : "ok");
         print "    $msg $dots $have\n";
     } else {
-        $have = $have ? "MISSING (have $have)" : "MISSING";
+        $have = bright_red($have ? "MISSING (have $have)" : "MISSING");
         print "    $msg $dots $have\n";
-        print "        $extra\n" if $extra;
+        print "        ". bright_red($extra) . "\n" if $extra;
     }
 }
 
 sub conclude {
     print "\n", "-" x 75, "\n\n";
     unless ( keys %deps ) {
-        print "All dependencies found.\n\n";
+        print bright_green("All dependencies found.\n\n");
         return;
     }
 
-    print "SOME DEPENDENCIES WERE MISSING:\n\n";
+    print bright_red("SOME DEPENDENCIES WERE MISSING:\n\n");
 
     foreach my $type ( sort keys %deps ) {
         section("$type dependencies");

commit 4d50869493b80efad910b49108f2b02a27bbabe9
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sun Jun 5 12:50:40 2016 -0700

    Move database and deployment defaults into rt-test-dependencies
    
    rt-test-dependencies is rewritten with most, but not all, of its
    arguments set to their configure-time values.  However, it requires
    that users pass in the appropriate values for their database and
    deployment method -- the two most key configuration settings.  Running
    rt-test-dependencies directly (instead of via `make testdeps`) can
    thus lead to a false belief that all dependencies are satisfied,
    because deployment and database dependencies are not being checked.
    
    Move the dependency and deployment defaulting into
    rt-test-dependencies, from the Makefile.  In case rt-test-dependencies
    is being called with an explicit database or deployment type, these
    defaults are only set if no explicit setting is observed on the
    command line.

diff --git a/Makefile.in b/Makefile.in
index a57c073..75190c0 100644
--- a/Makefile.in
+++ b/Makefile.in
@@ -265,14 +265,13 @@ upgrade-instruct:
 
 upgrade: testdeps config-install dirs files-install fixperms upgrade-instruct
 
-my_with_web_handlers= $(shell $(PERL) -e 'print join " ", map "--with-$$_", grep defined && length, split /,/, "$(WEB_HANDLER)"')
 testdeps:
-	$(PERL) ./sbin/rt-test-dependencies --with-$(DB_TYPE) $(my_with_web_handlers)
+	$(PERL) ./sbin/rt-test-dependencies
 
 depends: fixdeps
 
 fixdeps:
-	$(PERL) ./sbin/rt-test-dependencies --install --with-$(DB_TYPE) $(my_with_web_handlers)
+	$(PERL) ./sbin/rt-test-dependencies --install
 
 #}}}
 
diff --git a/sbin/rt-test-dependencies.in b/sbin/rt-test-dependencies.in
index fd771ce..9e812e4 100644
--- a/sbin/rt-test-dependencies.in
+++ b/sbin/rt-test-dependencies.in
@@ -101,6 +101,13 @@ my %default = (
     'with-S3'           => (uc(q{@ATTACHMENT_STORE@}) eq 'S3'),
     'with-DROPBOX'      => (uc(q{@ATTACHMENT_STORE@}) eq 'DROPBOX'),
 );
+
+$default{"with-".uc("@DB_TYPE@")} = 1 unless grep {$args{"with-$_"}} qw/MYSQL PG SQLITE ORACLE/;
+unless (grep {$args{"with-$_"}} qw/FASTCGI MODPERL1 MODPERL2 STANDALONE/) {
+    $default{"with-".uc($_)} = 1 for grep {defined && length} split /,/, "@WEB_HANDLER@"
+}
+
+
 $args{$_} = $default{$_} foreach grep {!exists $args{$_}} keys %default;
 
 $args{'with-EXTERNALAUTH-TESTS'}

commit caddbd6587925d973ba5aa81d7a2e393b6bf62b2
Author: Alex Vandiver <alex at chmrr.net>
Date:   Thu Jun 9 14:44:16 2016 -0700

    Encode::Guess is included in Encode 1.60 and above; RT requires 2.64
    
    This is not an optional dependency; it is guaranteed to be included in
    the Encode distribution that RT requires.

diff --git a/lib/RT/I18N.pm b/lib/RT/I18N.pm
index 60a6622..60ccaba 100644
--- a/lib/RT/I18N.pm
+++ b/lib/RT/I18N.pm
@@ -65,6 +65,7 @@ use base 'Locale::Maketext::Fuzzy';
 use MIME::Entity;
 use MIME::Head;
 use File::Glob;
+use Encode::Guess;
 
 # I decree that this project's first language is English.
 
@@ -506,11 +507,11 @@ sub _FindOrGuessCharset {
 
 =head2 _GuessCharset STRING
 
-use Encode::Guess to try to figure it out the string's encoding.
+Use Encode::Guess, and optionally Encode::Detect::Detector, to try to
+figure it out the string's encoding.
 
 =cut
 
-use constant HAS_ENCODE_GUESS => Encode::Guess->require;
 use constant HAS_ENCODE_DETECT => Encode::Detect::Detector->require;
 
 sub _GuessCharset {
@@ -551,11 +552,6 @@ sub _GuessCharset {
         return $fallback;
     }
 
-    unless ( HAS_ENCODE_GUESS ) {
-        $RT::Logger->error("We couldn't load Encode::Guess module, fallback to $fallback");
-        return $fallback;
-    }
-
     Encode::Guess->set_suspects( @encodings );
     my $decoder = Encode::Guess->guess( $_[0] );
     unless ( defined $decoder ) {
diff --git a/t/api/i18n_guess.t b/t/api/i18n_guess.t
index 0a99011..870ab95 100644
--- a/t/api/i18n_guess.t
+++ b/t/api/i18n_guess.t
@@ -4,7 +4,6 @@ use warnings;
 
 use RT::Test tests => 16;
 
-use constant HAS_ENCODE_GUESS => Encode::Guess->require;
 use constant HAS_ENCODE_DETECT => Encode::Detect::Detector->require;
 
 my $string = "\x{442}\x{435}\x{441}\x{442} \x{43f}\x{43e}\x{434}\x{434}\x{435}\x{440}\x{436}\x{43a}\x{430}";
@@ -24,7 +23,6 @@ SKIP: {
 
 RT->Config->Set(EmailInputEncodings => qw(UTF-8 cp1251 koi8-r));
 SKIP: {
-    skip "No Encode::Guess", 4 unless HAS_ENCODE_GUESS;
     guess('utf-8', $string);
     guess('cp1251', $string);
     guess('windows-1251', $string, 'cp1251');
@@ -36,7 +34,6 @@ SKIP: {
 
 RT->Config->Set(EmailInputEncodings => qw(UTF-8 koi8-r cp1251));
 SKIP: {
-    skip "No Encode::Guess", 3 unless HAS_ENCODE_GUESS;
     guess('utf-8', $string);
     guess('koi8-r', $string);
     {
@@ -49,7 +46,6 @@ SKIP: {
 RT->Config->Set(EmailInputEncodings => qw(UTF-8 windows-1251 koi8-r));
 RT->Config->PostLoadCheck;
 SKIP: {
-    skip "No Encode::Guess", 3 unless HAS_ENCODE_GUESS;
     guess('utf-8', $string);
     guess('cp1251', $string);
     {

commit 6e68c08c38d21b33a375954aa949af64c1086cf4
Author: Alex Vandiver <alex at chmrr.net>
Date:   Thu Jul 21 23:51:57 2016 -0700

    Make Encode::Detect::Detector a required dependency
    
    Encode::Detect::Detector was only used if configured in RT_Config.pm,
    and if the optional dependency had been installed.  Instead, always
    install it as a dependency, and better document how it functions to
    help administrators to understand the option.  This removes a
    mostly-undocumented optional dependency.

diff --git a/etc/RT_Config.pm.in b/etc/RT_Config.pm.in
index 705c6c9..0b5d1c7 100644
--- a/etc/RT_Config.pm.in
+++ b/etc/RT_Config.pm.in
@@ -2586,9 +2586,35 @@ Set(@LexiconLanguages, qw(*));
 
 An array that contains default encodings used to guess which charset
 an attachment uses, if it does not specify one explicitly.  All
-options must be recognized by L<Encode::Guess>.  The first element may
-also be '*', which enables encoding detection using
-L<Encode::Detect::Detector>, if installed.
+options must be recognized by L<Encode::Guess>.
+
+The first element may also be C<*>, which attempts encoding detection
+using L<Encode::Detect::Detector>.  This uses Mozilla's character
+detection library to examine the bytes, and use frequency metrics to
+rank the options.  This detection may fail (and fall back to other
+options in the C<@EmailInputEncodings> list) if no decoding has high
+enough confidence metrics.  As of L<Encode::Detect::Detector> version
+1.01, it knows the following encodings:
+
+    big5-eten
+    cp1250
+    cp1251
+    cp1253
+    cp1255
+    cp855
+    cp866
+    euc-jp
+    euc-kr
+    euc-tw
+    gb18030
+    iso-8859-2
+    iso-8859-5
+    iso-8859-7
+    iso-8859-11
+    koi8-r
+    MacCyrillic
+    shiftjis
+    utf-8
 
 =cut
 
diff --git a/etc/cpanfile b/etc/cpanfile
index 354114f..4d29848 100644
--- a/etc/cpanfile
+++ b/etc/cpanfile
@@ -30,6 +30,7 @@ requires 'Digest::SHA';
 requires 'Email::Address', '>= 1.897';
 requires 'Email::Address::List', '>= 0.02';
 requires 'Encode', '>= 2.64';
+requires 'Encode::Detect::Detector';
 requires 'Errno';
 requires 'File::Glob';
 requires 'File::ShareDir';
diff --git a/lib/RT/I18N.pm b/lib/RT/I18N.pm
index 60ccaba..5ae08c2 100644
--- a/lib/RT/I18N.pm
+++ b/lib/RT/I18N.pm
@@ -66,6 +66,7 @@ use MIME::Entity;
 use MIME::Head;
 use File::Glob;
 use Encode::Guess;
+use Encode::Detect::Detector;
 
 # I decree that this project's first language is English.
 
@@ -507,13 +508,11 @@ sub _FindOrGuessCharset {
 
 =head2 _GuessCharset STRING
 
-Use Encode::Guess, and optionally Encode::Detect::Detector, to try to
-figure it out the string's encoding.
+Use L<Encode::Guess> and L<Encode::Detect::Detector> to try to figure it out
+the string's encoding.
 
 =cut
 
-use constant HAS_ENCODE_DETECT => Encode::Detect::Detector->require;
-
 sub _GuessCharset {
     my $fallback = _CanonicalizeCharset('iso-8859-1');
 
@@ -529,21 +528,12 @@ sub _GuessCharset {
 
     if ( $encodings[0] eq '*' ) {
         shift @encodings;
-        if ( HAS_ENCODE_DETECT ) {
-            my $charset = Encode::Detect::Detector::detect( $_[0] );
-            if ( $charset ) {
-                $RT::Logger->debug("Encode::Detect::Detector guessed encoding: $charset");
-                return _CanonicalizeCharset( Encode::resolve_alias( $charset ) );
-            }
-            else {
-                $RT::Logger->debug("Encode::Detect::Detector failed to guess encoding");
-            }
-        }
-        else {
-            $RT::Logger->error(
-                "You requested to guess encoding, but we couldn't"
-                ." load Encode::Detect::Detector module"
-            );
+        my $charset = Encode::Detect::Detector::detect( $_[0] );
+        if ( $charset ) {
+            $RT::Logger->debug("Encode::Detect::Detector guessed encoding: $charset");
+            return _CanonicalizeCharset( Encode::resolve_alias( $charset ) );
+        } else {
+            $RT::Logger->debug("Encode::Detect::Detector failed to guess encoding");
         }
     }
 
diff --git a/t/api/i18n_guess.t b/t/api/i18n_guess.t
index 870ab95..4de90cc 100644
--- a/t/api/i18n_guess.t
+++ b/t/api/i18n_guess.t
@@ -4,8 +4,6 @@ use warnings;
 
 use RT::Test tests => 16;
 
-use constant HAS_ENCODE_DETECT => Encode::Detect::Detector->require;
-
 my $string = "\x{442}\x{435}\x{441}\x{442} \x{43f}\x{43e}\x{434}\x{434}\x{435}\x{440}\x{436}\x{43a}\x{430}";
 
 sub guess {
@@ -15,7 +13,6 @@ sub guess {
 
 RT->Config->Set(EmailInputEncodings => qw(*));
 SKIP: {
-    skip "No Encode::Detect", 3 unless HAS_ENCODE_DETECT;
     guess('utf-8', $string);
     guess('cp1251', $string);
     guess('koi8-r', $string);
@@ -56,7 +53,6 @@ SKIP: {
 
 RT->Config->Set(EmailInputEncodings => qw(* UTF-8 cp1251 koi8-r));
 SKIP: {
-    skip "No Encode::Detect", 3 unless HAS_ENCODE_DETECT;
     guess('utf-8', $string);
     guess('cp1251', $string);
     guess('koi8-r', $string);

commit b7cdb92a88913d11cc6ffb246f07b66b017f6ce3
Author: Alex Vandiver <alex at chmrr.net>
Date:   Sat Jul 23 19:15:50 2016 -0700

    Make Encode::HanExtra a required dependency
    
    This makes RT better able to handle non-European mail.  While
    previously an error was placed in the logs suggesting the installation
    if a message was encounted which needed it, it was already too late
    for that message.
    
    There is functionally no cost to making it a required dependency; add
    it.

diff --git a/etc/cpanfile b/etc/cpanfile
index 4d29848..bb82da6 100644
--- a/etc/cpanfile
+++ b/etc/cpanfile
@@ -31,6 +31,7 @@ requires 'Email::Address', '>= 1.897';
 requires 'Email::Address::List', '>= 0.02';
 requires 'Encode', '>= 2.64';
 requires 'Encode::Detect::Detector';
+requires 'Encode::HanExtra';
 requires 'Errno';
 requires 'File::Glob';
 requires 'File::ShareDir';
diff --git a/lib/RT/I18N.pm b/lib/RT/I18N.pm
index 5ae08c2..f8ef86b 100644
--- a/lib/RT/I18N.pm
+++ b/lib/RT/I18N.pm
@@ -65,6 +65,7 @@ use base 'Locale::Maketext::Fuzzy';
 use MIME::Entity;
 use MIME::Head;
 use File::Glob;
+use Encode::HanExtra;
 use Encode::Guess;
 use Encode::Detect::Detector;
 
@@ -594,12 +595,6 @@ sub _CanonicalizeCharset {
         # gbk is superset of gb2312/euc-cn so it's safe
         return 'gbk';
     }
-    elsif ( $charset =~ /^(?:(?:big5(-1984|-2003|ext|plus))|cccii|unisys|euc-tw|gb18030|(?:cns11643-\d+))$/ ) {
-        unless ( Encode::HanExtra->require ) {
-            RT->Logger->error("Please install Encode::HanExtra to handle $charset");
-        }
-        return $charset;
-    }
     else {
         return $charset;
     }

commit fdf53ec63fc76310b3c99e55db6aa04158521608
Author: Alex Vandiver <alex at chmrr.net>
Date:   Thu Jul 21 21:53:13 2016 -0700

    Make HTML::FormatExternal dependency required, not runtime optional
    
    Previously, installing the optional HTML::FormatExternal dependency
    altered RT's behavior when downgrading HTML-only messages (both
    incoming and outgoing) into plain text, by using external programs as
    rendering engines.  This improved on the pure-perl
    HTML::FormatText::WithLinks::AndTables greatly, especially as that
    module sometimes threw exceptions and produced no output.
    
    Make it no longer a sparsely-documented optional dependency, but
    rather a core dependency.

diff --git a/etc/cpanfile b/etc/cpanfile
index bb82da6..6425c35 100644
--- a/etc/cpanfile
+++ b/etc/cpanfile
@@ -38,6 +38,7 @@ requires 'File::ShareDir';
 requires 'File::Spec', '>= 0.8';
 requires 'File::Temp', '>= 0.19';
 requires 'HTML::Entities';
+requires 'HTML::FormatExternal';
 requires 'HTML::FormatText::WithLinks', '>= 0.14';
 requires 'HTML::FormatText::WithLinks::AndTables', '>= 0.06';
 requires 'HTML::Mason', '>= 1.43';
diff --git a/lib/RT/Interface/Email.pm b/lib/RT/Interface/Email.pm
index 23543fc..7587f78 100644
--- a/lib/RT/Interface/Email.pm
+++ b/lib/RT/Interface/Email.pm
@@ -1456,12 +1456,6 @@ sub _HTMLFormatter {
             require HTML::FormatText::WithLinks::AndTables;
             $formatter = \&_HTMLFormatText;
         } else {
-            unless (HTML::FormatExternal->require) {
-                RT->Logger->warn("HTML::FormatExternal is not installed; falling back to internal perl formatter")
-                    if $wanted;
-                next;
-            }
-
             my $path = $prog =~ s{(.*/)}{} ? $1 : undef;
             my $package = "HTML::FormatText::" . ucfirst($prog);
             unless ($package->require) {

commit 8782803df56fceb367c6f25af604df36d2084ead
Author: Alex Vandiver <alex at chmrr.net>
Date:   Thu Jul 21 22:52:34 2016 -0700

    Make HTML::Gumbo required, and split scrubbing into its own class
    
    HTML::Gumbo was previously an optional runtime dependency, which
    allowed tables to not be scrubbed because it guaranteed that the
    user-provided content couldn't "escape" the confines of the
    transaction history.
    
    Make HTML::Gumbo a required dependency, allowing tables in HTML for
    all installations of RT.  In doing so, factor out the HTML-scrubbing
    code into its own class, for compartmentalization.

diff --git a/docs/UPGRADING-4.6 b/docs/UPGRADING-4.6
new file mode 100644
index 0000000..6755ffa
--- /dev/null
+++ b/docs/UPGRADING-4.6
@@ -0,0 +1,24 @@
+=head1 UPGRADING FROM RT 4.4.0 and greater
+
+The 4.6 release is a major upgrade and as such there are more changes
+than in a minor bugfix release (e.g., 4.4.0 to 4.4.1) and some of these
+changes are backward-incompatible. The following lists some of the notable
+changes, especially those that might require you to change a configuration
+option or other setting due to a change in RT. Read this section carefully
+before you upgrade and look for changes to features you currently use.
+
+See F<devel/docs/UPGRADING-4.6> for internals changes relevant to
+extension writers.
+
+=over
+
+=item *
+
+The variables which alter the set of HTML elements allowed in HTML
+scrubbing have moved; they have been renamed, and are now found under
+L<RT::Interface::Web::Scrubber>.
+
+=back
+
+=cut
+
diff --git a/etc/RT_Config.pm.in b/etc/RT_Config.pm.in
index 0b5d1c7..bf9f01e 100644
--- a/etc/RT_Config.pm.in
+++ b/etc/RT_Config.pm.in
@@ -2033,9 +2033,6 @@ multiple vectors for XSS and phishing attacks.  If
 L</$TrustHTMLAttachments> is enabled, the original HTML is available for
 viewing via the "Download" link.
 
-If the optional L<HTML::Gumbo> dependency is installed, RT will leverage
-this to allow a broader set of HTML through, including tables.
-
 =cut
 
 Set($PreferRichText, 1);
diff --git a/etc/cpanfile b/etc/cpanfile
index 6425c35..59e4b3c 100644
--- a/etc/cpanfile
+++ b/etc/cpanfile
@@ -41,6 +41,7 @@ requires 'HTML::Entities';
 requires 'HTML::FormatExternal';
 requires 'HTML::FormatText::WithLinks', '>= 0.14';
 requires 'HTML::FormatText::WithLinks::AndTables', '>= 0.06';
+requires 'HTML::Gumbo';
 requires 'HTML::Mason', '>= 1.43';
 requires 'HTML::Mason::PSGIHandler', '>= 0.52';
 requires 'HTML::Quoted';
diff --git a/lib/RT/Interface/Web.pm b/lib/RT/Interface/Web.pm
index e3cf905..33e810d 100644
--- a/lib/RT/Interface/Web.pm
+++ b/lib/RT/Interface/Web.pm
@@ -60,6 +60,7 @@ RT::Interface::Web
 
 use strict;
 use warnings;
+use 5.010;
 
 package RT::Interface::Web;
 
@@ -68,6 +69,7 @@ use RT::CustomRoles;
 use URI qw();
 use RT::Interface::Web::Menu;
 use RT::Interface::Web::Session;
+use RT::Interface::Web::Scrubber;
 use Digest::MD5 ();
 use List::MoreUtils qw();
 use JSON qw();
@@ -4261,129 +4263,9 @@ Removes unsafe and undesired HTML from the passed content
 
 =cut
 
-my $SCRUBBER;
 sub ScrubHTML {
-    my $Content = shift;
-    $SCRUBBER = _NewScrubber() unless $SCRUBBER;
-
-    $Content = '' if !defined($Content);
-    return $SCRUBBER->scrub($Content);
-}
-
-=head2 _NewScrubber
-
-Returns a new L<HTML::Scrubber> object.
-
-If you need to be more lax about what HTML tags and attributes are allowed,
-create C</opt/rt4/local/lib/RT/Interface/Web_Local.pm> with something like the
-following:
-
-    package HTML::Mason::Commands;
-    # Let tables through
-    push @SCRUBBER_ALLOWED_TAGS, qw(TABLE THEAD TBODY TFOOT TR TD TH);
-    1;
-
-=cut
-
-our @SCRUBBER_ALLOWED_TAGS = qw(
-    A B U P BR I HR BR SMALL EM FONT SPAN STRONG SUB SUP S DEL STRIKE H1 H2 H3 H4 H5
-    H6 DIV UL OL LI DL DT DD PRE BLOCKQUOTE BDO
-);
-
-our %SCRUBBER_ALLOWED_ATTRIBUTES = (
-    # Match http, https, ftp, mailto and relative urls
-    # XXX: we also scrub format strings with this module then allow simple config options
-    href   => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|HomePath|BaseURL|URL)__)}i,
-    face   => 1,
-    size   => 1,
-    color  => 1,
-    target => 1,
-    style  => qr{
-        ^(?:\s*
-            (?:(?:background-)?color: \s*
-                    (?:rgb\(\s* \d+, \s* \d+, \s* \d+ \s*\) |   # rgb(d,d,d)
-                       \#[a-f0-9]{3,6}                      |   # #fff or #ffffff
-                       [\w\-]+                                  # green, light-blue, etc.
-                       )                            |
-               text-align: \s* \w+                  |
-               font-size: \s* [\w.\-]+              |
-               font-family: \s* [\w\s"',.\-]+       |
-               font-weight: \s* [\w\-]+             |
-
-               border-style: \s* \w+                |
-               border-color: \s* [#\w]+             |
-               border-width: \s* [\s\w]+            |
-               padding: \s* [\s\w]+                 |
-               margin: \s* [\s\w]+                  |
-
-               # MS Office styles, which are probably fine.  If we don't, then any
-               # associated styles in the same attribute get stripped.
-               mso-[\w\-]+?: \s* [\w\s"',.\-]+
-            )\s* ;? \s*)
-         +$ # one or more of these allowed properties from here 'till sunset
-    }ix,
-    dir    => qr/^(rtl|ltr)$/i,
-    lang   => qr/^\w+(-\w+)?$/,
-
-    # timeworked per user attributes
-    'data-ticket-id'    => 1,
-    'data-ticket-class' => 1,
-);
-
-our %SCRUBBER_RULES = ();
-
-# If we're displaying images, let embedded ones through
-if (RT->Config->Get('ShowTransactionImages') or RT->Config->Get('ShowRemoteImages')) {
-    $SCRUBBER_RULES{'img'} = {
-        '*' => 0,
-        alt => 1,
-    };
-
-    my @src;
-    push @src, qr/^cid:/i
-        if RT->Config->Get('ShowTransactionImages');
-
-    push @src, $SCRUBBER_ALLOWED_ATTRIBUTES{'href'}
-        if RT->Config->Get('ShowRemoteImages');
-
-    $SCRUBBER_RULES{'img'}->{'src'} = join "|", @src;
-}
-
-sub _NewScrubber {
-    require HTML::Scrubber;
-    my $scrubber = HTML::Scrubber->new();
-
-    if (HTML::Gumbo->require) {
-        no warnings 'redefine';
-        my $orig = \&HTML::Scrubber::scrub;
-        *HTML::Scrubber::scrub = sub {
-            my $self = shift;
-
-            eval { $_[0] = HTML::Gumbo->new->parse( $_[0] ); chomp $_[0] };
-            warn "HTML::Gumbo pre-parse failed: $@" if $@;
-            return $orig->($self, @_);
-        };
-        push @SCRUBBER_ALLOWED_TAGS, qw/TABLE THEAD TBODY TFOOT TR TD TH/;
-        $SCRUBBER_ALLOWED_ATTRIBUTES{$_} = 1 for
-            qw/colspan rowspan align valign cellspacing cellpadding border width height/;
-    }
-
-    $scrubber->default(
-        0,
-        {
-            %SCRUBBER_ALLOWED_ATTRIBUTES,
-            '*' => 0, # require attributes be explicitly allowed
-        },
-    );
-    $scrubber->deny(qw[*]);
-    $scrubber->allow(@SCRUBBER_ALLOWED_TAGS);
-    $scrubber->rules(%SCRUBBER_RULES);
-
-    # Scrubbing comments is vital since IE conditional comments can contain
-    # arbitrary HTML and we'd pass it right on through.
-    $scrubber->comment(0);
-
-    return $scrubber;
+    state $scrubber = RT::Interface::Web::Scrubber->new;
+    return $scrubber->scrub(@_);
 }
 
 =head2 JSON
diff --git a/lib/RT/Interface/Web/Scrubber.pm b/lib/RT/Interface/Web/Scrubber.pm
new file mode 100644
index 0000000..dccc824
--- /dev/null
+++ b/lib/RT/Interface/Web/Scrubber.pm
@@ -0,0 +1,181 @@
+package RT::Interface::Web::Scrubber;
+use 5.010;
+use base qw/HTML::Scrubber/;
+
+use HTML::Gumbo;
+
+=head1 NAME
+
+RT::Interface::Web::Scrubber
+
+=head1 DESCRIPTION
+
+This is a subclass of L<HTML::Scrubber> which automatically configures
+itself with a sane and safe default set of rules.  Additionally, it
+ensures that the input is balanced HTML by use of the L<HTML::Gumbo>
+on the input to L</scrub>.
+
+=head1 VARIABLES
+
+These variables can be altered by creating a C<Scrubber_Local.pm>
+file, containing something of the form:
+
+    package RT::Interface::Web::Scrubber;
+
+    # Allow the "title" attribute
+    $ALLOWED_ATTRIBUTES{title} = 1;
+
+=over
+
+=item C<@ALLOWED_TAGS>
+
+Passed to L<HTML::Scrubber/allow>.
+
+=item C<%ALLOWED_ATTRIBUTES>
+
+Passed into L<HTML::Scrubber/default>.
+
+=item C<%RULES>
+
+Passed to L<HTML::Scrubber/rules>.
+
+=back
+
+=cut
+
+our @ALLOWED_TAGS = qw(
+    A B U P BR I HR BR SMALL EM FONT SPAN STRONG SUB SUP S DEL STRIKE H1 H2 H3 H4 H5
+    H6 DIV UL OL LI DL DT DD PRE BLOCKQUOTE BDO TABLE THEAD TBODY TFOOT TR TD TH
+);
+
+our %ALLOWED_ATTRIBUTES = (
+    # Match http, https, ftp, mailto and relative urls
+    # XXX: we also scrub format strings with this module then allow simple config options
+    href   => qr{^(?:https?:|ftp:|mailto:|/|__Web(?:Path|HomePath|BaseURL|URL)__)}i,
+    face   => 1,
+    size   => 1,
+    color  => 1,
+    target => 1,
+    style  => qr{
+        ^(?:\s*
+            (?:(?:background-)?color: \s*
+                    (?:rgb\(\s* \d+, \s* \d+, \s* \d+ \s*\) |   # rgb(d,d,d)
+                       \#[a-f0-9]{3,6}                      |   # #fff or #ffffff
+                       [\w\-]+                                  # green, light-blue, etc.
+                       )                            |
+               text-align: \s* \w+                  |
+               font-size: \s* [\w.\-]+              |
+               font-family: \s* [\w\s"',.\-]+       |
+               font-weight: \s* [\w\-]+             |
+
+               border-style: \s* \w+                |
+               border-color: \s* [#\w]+             |
+               border-width: \s* [\s\w]+            |
+               padding: \s* [\s\w]+                 |
+               margin: \s* [\s\w]+                  |
+
+               # MS Office styles, which are probably fine.  If we don't, then any
+               # associated styles in the same attribute get stripped.
+               mso-[\w\-]+?: \s* [\w\s"',.\-]+
+            )\s* ;? \s*)
+         +$ # one or more of these allowed properties from here 'till sunset
+    }ix,
+    dir    => qr/^(rtl|ltr)$/i,
+    lang   => qr/^\w+(-\w+)?$/,
+
+    colspan     => 1,
+    rowspan     => 1,
+    align       => 1,
+    valign      => 1,
+    cellspacing => 1,
+    cellpadding => 1,
+    border      => 1,
+    width       => 1,
+    height      => 1,
+
+    # timeworked per user attributes
+    'data-ticket-id'    => 1,
+    'data-ticket-class' => 1,
+);
+
+our %RULES = ();
+
+=head1 METHODS
+
+=head2 new
+
+Returns a new L<RT::Interface::Web::Scrubber> object, configured with
+the above globals.  Takes no arguments.
+
+=cut
+
+sub new {
+    my $class = shift;
+    $self = $class->SUPER::new(@_);
+
+    $self->default(
+        0,
+        {
+            %ALLOWED_ATTRIBUTES,
+            '*' => 0, # require attributes be explicitly allowed
+        },
+    );
+    $self->deny(qw[*]);
+    $self->allow(@ALLOWED_TAGS);
+
+    # If we're displaying images, let embedded ones through
+    if (RT->Config->Get('ShowTransactionImages') or RT->Config->Get('ShowRemoteImages')) {
+        my @src;
+        push @src, qr/^cid:/i
+            if RT->Config->Get('ShowTransactionImages');
+
+        push @src, $ALLOWED_ATTRIBUTES{'href'}
+            if RT->Config->Get('ShowRemoteImages');
+
+        $RULES{'img'} ||= {
+            '*' => 0,
+            alt => 1,
+            src => join("|", @src),
+        };
+    }
+    $self->rules(%RULES);
+
+    # Scrubbing comments is vital since IE conditional comments can contain
+    # arbitrary HTML and we'd pass it right on through.
+    $self->comment(0);
+
+    return $self;
+}
+
+=head2 gumbo
+
+Returns a L<HTML::Gumbo> object.
+
+=cut
+
+sub gumbo {
+    my $self = shift;
+    return $self->{_gumbo} //= HTML::Gumbo->new;
+}
+
+=head2 scrub TEXT
+
+Takes a string of HTML, and returns it scrubbed, via L<HTML::Gumbo>
+then the rules.  This is a more limited interface than
+L<HTML::Scrubber/scrub>.
+
+=cut
+
+sub scrub {
+    my $self = shift;
+    my $Content = shift // '';
+
+    # First pass through HTML::Gumbo to balance the tags
+    eval { $Content = $self->gumbo->parse( $Content ); chomp $Content };
+    warn "HTML::Gumbo pre-parse failed: $@" if $@;
+
+    return $self->SUPER::scrub($Content);
+}
+
+RT::Base->_ImportOverlays();
+1;
diff --git a/t/web/scrub.t b/t/web/scrub.t
index 835f412..4137986 100644
--- a/t/web/scrub.t
+++ b/t/web/scrub.t
@@ -1,10 +1,14 @@
 use strict;
 use warnings;
 
-use RT::Test nodb => 1, tests => 6;
+use RT::Test nodb => 1, tests => undef;
 use RT::Interface::Web; # This gets us HTML::Mason::Commands
 use Test::LongString;
 
+sub scrub_html {
+    return HTML::Mason::Commands::ScrubHTML(shift);
+}
+
 {
     my $html = 'This is a test of <span style="color: rgb(255, 0, 0); ">color</span> and <span style="font-size: 18px; "><span style="font-family: Georgia, serif; ">font</span></span> and <em><u><strike><strong>boldness</strong></strike></u></em>.';
     is_string(scrub_html($html), $html, "CKEditor produced HTML sails through");
@@ -39,7 +43,10 @@ use Test::LongString;
     is_string(scrub_html($html), $expected, "outlook html");
 }
 
-sub scrub_html {
-    return HTML::Mason::Commands::ScrubHTML(shift);
+{
+    my $html = q[</td></tr></table><table><td>Some content here</table>An unclosed <b>bold<b> tag.];
+    my $expected = q[<table><tbody><tr><td>Some content here</td></tr></tbody></table>An unclosed <b>bold<b> tag.</b></b>];
+    is_string(scrub_html($html), $expected, "Unbalanced tags get balanced");
 }
 
+done_testing;

-----------------------------------------------------------------------


More information about the rt-commit mailing list