lib/DBIx/Class/StartupCheck.pm

   1 package DBIx::Class::StartupCheck;
   2
   3 BEGIN {
   4
   5     { package # don't want this in PAUSE
   6         TestRHBug; use overload bool => sub { 0 } }
   7
   8     sub _has_bug_34925 {
   9         my %thing;
  10         my $r1 = \%thing;
  11         my $r2 = \%thing;
  12         bless $r1 => 'TestRHBug';
  13         return !!$r2;
  14     }
  15
  16     sub _possibly_has_bad_overload_performance {
  17         return $] < 5.008009 && ! _has_bug_34925();
  18     }
  19
  20     unless ($ENV{DBIC_NO_WARN_BAD_PERL}) {
  21         if (_possibly_has_bad_overload_performance()) {
  22             print STDERR "\n\nWARNING: " . __PACKAGE__ . ": This version of Perl is likely to exhibit\n" .
  23                 "extremely slow performance for certain critical operations.\n" .
  24                 "Please consider recompiling Perl.  For more information, see\n" .
  25                 "https://bugzilla.redhat.com/show_bug.cgi?id=196836 and/or\n" .
  26                 "http://lists.scsys.co.uk/pipermail/dbix-class/2007-October/005119.html.\n" .
  27                 "You can suppress this message by setting DBIC_NO_WARN_BAD_PERL=1 in your\n" .
  28                 "environment.\n\n";
  29         }
  30     }
  31 }
  32
  33 =head1 NAME
  34
  35 DBIx::Class::StartupCheck - Run environment checks on startup
  36
  37 =head1 SYNOPSIS
  38
  39   use DBIx::Class::StartupCheck;
  40
  41 =head1 DESCRIPTION
  42
  43 Currently this module checks for, and if necessary issues a warning for, a
  44 particular bug found on RedHat systems from perl-5.8.8-10 and up.  Other checks
  45 may be added from time to time.
  46
  47 Any checks herein can be disabled by setting an appropriate environment
  48 variable.  If your system suffers from a particular bug, you will get a warning
  49 message on startup sent to STDERR, explaining what to do about it and how to
  50 suppress the message.  If you don't see any messages, you have nothing to worry
  51 about.
  52
  53 =head1 CONTRIBUTORS
  54
  55 Nigel Metheringham
  56
  57 Brandon Black
  58
  59 Matt S. Trout
  60
  61 =head1 AUTHOR
  62
  63 Jon Schutz
  64
  65 =head1 LICENSE
  66
  67 You may distribute this code under the same terms as Perl itself.
  68
  69 =cut
  70
  71 1;