From: Ash Berlin <ash_github@firemirror.com>
Date: Sat, 20 Oct 2007 11:01:07 +0000 (+0000)
Subject: Added startup checks to warn loudly if we appear to be running on RedHat systems... 
X-Git-Tag: v0.08010~46
X-Git-Url: http://git.shadowcat.co.uk/gitweb/gitweb.cgi?a=commitdiff_plain;h=11736b4c186bbc10c80f13fdb1eca80b1ff75711;hp=5f94607105ef995064a59fe814d89a6d7e63eab5;p=dbsrgits%2FDBIx-Class.git

Added startup checks to warn loudly if we appear to be running on RedHat systems from perl-5.8.8-10 and up that have the bless/overload patch applied (badly) which causes 2x -> 100x performance penalty.  (Jon Schutz)
---

diff --git a/Changes b/Changes
index 3aa01e8..03b10ba 100644
--- a/Changes
+++ b/Changes
@@ -10,6 +10,10 @@ Revision history for DBIx::Class
           to set timezone on the DT object (thanks Sergio Salvi)
         - Added sqlt_deploy_hook to result classes so that indexes can be 
           added.
+        - Added startup checks to warn loudly if we appear to be running on 
+          RedHat systems from perl-5.8.8-10 and up that have the bless/overload
+          patch applied (badly) which causes 2x -> 100x performance penalty.
+          (Jon Schutz)
 
 0.08007 2007-09-04 19:36:00
         - patch for Oracle datetime inflation (abram@arin.net)
diff --git a/lib/DBIx/Class.pm b/lib/DBIx/Class.pm
index 745f857..3b591cb 100644
--- a/lib/DBIx/Class.pm
+++ b/lib/DBIx/Class.pm
@@ -5,6 +5,7 @@ use warnings;
 
 use vars qw($VERSION);
 use base qw/DBIx::Class::Componentised Class::Accessor::Grouped/;
+use DBIx::Class::StartupCheck;
 
 
 sub mk_classdata { 
@@ -233,6 +234,8 @@ jguenther: Justin Guenther <jguenther@cpan.org>
 
 jnapiorkowski: John Napiorkowski <jjn1056@yahoo.com>
 
+jon: Jon Schutz <jjschutz@cpan.org>
+
 jshirley: J. Shirley <jshirley@gmail.com>
 
 konobi: Scott McWhirter
diff --git a/lib/DBIx/Class/Manual/Intro.pod b/lib/DBIx/Class/Manual/Intro.pod
index d4ee303..974efe5 100644
--- a/lib/DBIx/Class/Manual/Intro.pod
+++ b/lib/DBIx/Class/Manual/Intro.pod
@@ -373,6 +373,16 @@ L<DBIx::Class::ResultSet/METHODS>.
 For a complete overview of the available attributes, see
 L<DBIx::Class::ResultSet/ATTRIBUTES>.
 
+=head1 NOTES
+
+=head2 Problems on RHEL5/CentOS5
+
+There is a problem with slow performance of certain DBIx::Class operations in
+perl-5.8.8-10 and later on RedHat and related systems, due to a bad backport of
+a "use overload" related bug.  The problem is in the Perl binary itself, not in
+DBIx::Class.  If your system has this problem, you will see a warning on
+startup, with some options as to what to do about it.
+
 =head1 SEE ALSO
 
 =over 4
diff --git a/lib/DBIx/Class/StartupCheck.pm b/lib/DBIx/Class/StartupCheck.pm
new file mode 100644
index 0000000..4710192
--- /dev/null
+++ b/lib/DBIx/Class/StartupCheck.pm
@@ -0,0 +1,70 @@
+package DBIx::Class::StartupCheck;
+
+BEGIN {
+
+    { package TestRHBug; use overload bool => sub { 0 } }
+
+    sub _has_bug_34925 {
+	my %thing;
+	my $r1 = \%thing;
+	my $r2 = \%thing;
+	bless $r1 => 'TestRHBug';
+	return !!$r2;
+    }
+
+    sub _possibly_has_bad_overload_performance {
+	return $] < 5.008009 && ! _has_bug_34925();
+    }
+
+    unless ($ENV{DBIC_NO_WARN_BAD_PERL}) {
+	if (_possibly_has_bad_overload_performance()) {
+	    print STDERR "\n\nWARNING: " . __PACKAGE__ . ": This version of Perl is likely to exhibit\n" .
+		"extremely slow performance for certain critical operations.\n" .
+		"Please consider recompiling Perl.  For more information, see\n" .
+		"https://bugzilla.redhat.com/show_bug.cgi?id=196836 and/or\n" .
+		"http://lists.scsys.co.uk/pipermail/dbix-class/2007-October/005119.html.\n" .
+		"You can suppress this message by setting DBIC_NO_WARN_BAD_PERL=1 in your\n" .
+		"environment.\n\n";
+	}
+    }
+}
+
+=head1 NAME
+
+DBIx::Class::StartupCheck - Run environment checks on startup
+
+=head1 SYNOPSIS
+
+  use DBIx::Class::StartupCheck;
+  
+=head1 DESCRIPTION
+
+Currently this module checks for, and if necessary issues a warning for, a
+particular bug found on RedHat systems from perl-5.8.8-10 and up.  Other checks
+may be added from time to time.
+
+Any checks herein can be disabled by setting an appropriate environment
+variable.  If your system suffers from a particular bug, you will get a warning
+message on startup sent to STDERR, explaining what to do about it and how to
+suppress the message.  If you don't see any messages, you have nothing to worry
+about.
+
+=head1 CONTRIBUTORS
+
+Nigel Metheringham
+
+Brandon Black
+
+Matt S. Trout
+
+=head1 AUTHOR
+
+Jon Schutz
+
+=head1 LICENSE
+
+You may distribute this code under the same terms as Perl itself.
+
+=cut
+
+1;