package Module::Advisor; use strict; use warnings; use 5.008008; our $VERSION = '0.13'; use Module::Metadata; use CPAN::Meta::Requirements; use Carp; our @SECURITY = ( ['Digest' => '< 1.17', 'have a security issue. which could lead to the injection of arbitrary Perl code'], ['Encode' => '< 2.44', 'heap overflow'], ['Encode' => '< 2.49', 'memory leaks'], ); our @PERFORMANCE = ( ['UNIVERSAL::require', '< 0.11', 'is 400% faster'], ); our @BUG = ( ['Plack' => '< 0.9982', 'sanity check to remove newlines from headers'], ['Time::Piece' => '< 1.16', 'have timezone related issue'], ['DBD::SQLite' => '< 1.20', 'a lot of bugs.'], ['Text::Xslate' => '< 1.0011', '' bug.'], ['Text::Xslate' => '< 1.5021', 'segv in "render" recursion call'], ['Text::Xslate' => '< 1.6001', 'possibly memory leaks on VM stack frames. see https://github.com/xslate/p5-Text-Xslate/issues/71'], ['Furl' => '< 0.39', 'unexpected eof in reading chunked body. It makes busy loop.'], ['AnyEvent::MPRPC' => '< 0.15', 'switch to Data::MessagePack::Stream'], ['Data::MessagePack' => '< 0.46', 'fixed unpacking issue on big-endian system.'], ['Data::MessagePack' => '< 0.39', 'packing float numbers fails on some cases'], ['FCGI::Client' => '< 0.06', 'fixed large packet issue'], ['Starlet' => '< 0.12', 'fix infinite loop when connection is closed while receiving response content'], ['Starman' => '< 0.2014', '$res->[1] is broken after output (This is actualized with Plack::Middleware::AccessLog::Timed) https://github.com/miyagawa/Starman/pull/31'], ['Starman' => '< 0.1006', 'Fixed 100% CPU loop when an unexpected EOF happens'], ['Twiggy' => '< 0.1000', 'busy loop'], ['Teng', '< 0.14', 'fixed deflate bug.'], ['DBIx::Skinny', '< 0.0742', 'txn_scope bug fixed'], ['DBIx::TransactionManager', '< 1.11', 'not execute begin_work at AutoCommit=0.'], ['HTTP::MobileAgent' => '< 0.36', 'new x-up-devcap-multimedia(StandAloneGPS) support'], ['HTTP::MobileAgent' => '< 0.35', 'Updated $HTMLVerMap and $GPSModelsRe in DoCoMo.pm'], ['Encode::JP::Mobile' => '< 0.25', 'resolved FULLWIDTH TILDE issue, etc.'], ['Template' => '< 2.15', 'uri filter does not works properly https://rt.cpan.org/Public/Bug/Display.html?id=19593'], ['HTML::FillInForm::Lite' => '< 1.11', 'HTML5 style tags support'], ['Proc::Daemon' => '< 0.12', 'Init() did not close all filehandles reliably in some cases.'], ['ExclusiveLock::Guard' => '< 0.04', 'change of the file stat timing (measures under high load)'], # Broken in specific versions ['Amon2::DBI' => '== 0.31', 'transaction management bug'], ['Math::Random::MT' => '== 1.15', 'rand() took no notice of argument RT #78200'], ['Module::Install' => '== 1.04', 'Broken, http://weblog.bulknews.net/post/33907905561/do-not-ship-modules-with-module-install-1-04'], ['Mouse' => '== 1.04', 'Broken, http://d.hatena.ne.jp/gfx/20130208/1360283357'], ); our @XS = ( ['JSON' => 'JSON::XS'], # ['PPI' => 'PPI::XS'], # I think PPI::XS is outdated. ['Plack' => 'HTTP::Parser::XS'], ); if ($^O eq 'linux') { push @XS, ['Filesys::Notify::Simple', 'Linux::Inotify2']; } our @FEATURE = ( ['Amon2' => '< 3.29', 'JSON hijacking detection.'], ['Log::Minimal' => '< 0.10', 'LM_COLOR'], ['Log::Minimal' => '< 0.08', 'colourful logging'], ['Log::Minimal' => '< 0.03', 'ddf'], ['Proclet' => '< 0.12', 'Proclet::Declare'], ['DBI', '< 1.614' => 'AutoInactiveDestroy'], ['Module::Install::XSUtil', '< 0.44' => 'PUREPERL_ONLY=1'], ); our @OPTIONAL_MODULES = ( ['LWP', 'LWP::Protocol::https', 'Need to support https'], ); # ref. Module::Version sub get_version { my $module = shift or croak 'Must get a module name'; my $metadata = Module::Metadata->new_from_module($module); $metadata ? $metadata->version : undef; } sub debugf { my $self = shift; print "# @_\n" if $self->{verbose}; } sub new { my $class = shift; my %args = @_==1 ? %{$_[0]} : @_; bless {%args}, $class; } sub check { my ($self) = @_; my $failed = 0; $failed += $self->check_security(); $failed += $self->check_performance(); $failed += $self->check_bugs(); $failed += $self->check_xs_installed(); $failed += $self->check_feature(); return $failed; } sub matches_version { my($self, $module, $spec, $version) = @_; my $requirements = CPAN::Meta::Requirements->new; $requirements->add_string_requirement($module, $spec); $requirements->accepts_module($module, $version); } sub _check_issue { my ($self, $patterns, $type_name) = @_; my $failed = 0; for my $row (@$patterns) { my $ver = get_version($row->[0]); if (defined $ver) { $self->debugf("$row->[0] $ver"); if ($self->matches_version($row->[0], $row->[1], $ver)) { printf "[$type_name] %s %s %s: %s\n", $row->[0], $ver, $row->[1], $row->[2]; $failed++; } } else { $self->debugf("$row->[0] is not found"); } } return $failed; } sub check_security { my $self = shift; $self->_check_issue(\@SECURITY, 'SECURITY'); } sub check_performance { my $self = shift; $self->_check_issue(\@PERFORMANCE, 'PERFORMANCE'); } sub check_bugs { my $self = shift; $self->_check_issue(\@BUG, 'BUG'); } sub check_xs_installed { my ($self) = @_; my $failed = 0; for my $row (@XS) { my $pmver = get_version($row->[0]); if (defined $pmver) { my $xsver = get_version($row->[1]); if (defined $xsver) { $self->debugf("$row->[1] is also installed"); } else { printf "[XS] %s is need to install for better performance for %s\n", $row->[1], $row->[0]; } } else { $self->debugf("$row->[0] is not installed"); } } } sub _check_optional { my ($self, $rules, $type_name) = @_; my $failed = 0; for my $row (@$rules) { my $pmver = get_version($row->[0]); if (defined $pmver) { my $xsver = get_version($row->[1]); if (defined $xsver) { $self->debugf("$row->[1] is also installed"); } else { printf "[$type_name] %s => %s: %s\n", $row->[1], $row->[0], $row->[2]; } } else { $self->debugf("$row->[0] is not installed"); } } } sub check_feature { my $self = shift; $self->_check_optional(\@OPTIONAL_MODULES, 'OPTIONAL_MODULES'); } if (not defined caller(0)) { my $checker = __PACKAGE__->new(); $checker->{verbose}++ if $ENV{DEBUG}; $checker->check() or print "OK\n"; } 1;