1 package DBIx::Class::Carp;
6 # This is here instead of DBIx::Class because of load-order issues
8 # something is tripping up V::M on 5.8.1, leading to segfaults.
9 # A similar test in n::c itself is disabled on 5.8.1 for the same
10 # reason. There isn't much motivation to try to find why it happens
11 *DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN = ($] < 5.008005)
18 use namespace::clean ();
21 my ($skip_pattern, $class) = @_;
23 my $skip_class_data = $class->_skip_namespace_frames
24 if ($class and $class->can('_skip_namespace_frames'));
26 $skip_pattern = qr/$skip_pattern|$skip_class_data/
29 my $fr_num = 1; # skip us and the calling carp*
31 while (@f = caller($fr_num++)) {
32 last unless $f[0] =~ $skip_pattern;
35 $f[0]->can('_skip_namespace_frames')
37 my $extra_skip = $f[0]->_skip_namespace_frames
39 $skip_pattern = qr/$skip_pattern|$extra_skip/;
43 my ($ln, $calling) = @f # if empty - nothing matched - full stack
44 ? ( "at $f[1] line $f[2]", $f[3] )
45 : ( Carp::longmess(), '{UNKNOWN}' )
50 $calling =~ /::/ ? "$calling(): " : "$calling: ", # cargo-cult from Carp::Clan
56 @warn = "Warning: something's wrong" unless @warn;
58 # back-compat with Carp::Clan - a warning ending with \n does
59 # not include caller info
62 $warn[-1] =~ /\n$/ ? '' : " $ln\n"
67 my (undef, $skip_pattern) = @_;
70 $skip_pattern = $skip_pattern
71 ? qr/ ^ $into $ | $skip_pattern /xo
77 *{"${into}::carp"} = sub {
79 __find_caller($skip_pattern, $into),
85 *{"${into}::carp_once"} = sub {
90 __find_caller($skip_pattern, $into),
96 *{"${into}::carp_unique"} = sub {
97 my ($ln, $calling) = __find_caller($skip_pattern, $into);
98 my $msg = join ('', $calling, @_);
100 # unique carping with a hidden caller makes no sense
103 return if $seen->{$ln}{$msg};
104 $seen->{$ln}{$msg} = 1;
112 # cleanup after ourselves
113 namespace::clean->import(-cleanee => $into, qw/carp carp_once carp_unique/)
114 ## FIXME FIXME FIXME - something is tripping up V::M on 5.8.1, leading
115 # to segfaults. When n::c/B::H::EndOfScope is rewritten in terms of tie()
116 # see if this starts working
117 unless DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN();
121 die (__PACKAGE__ . " does not implement unimport yet\n");
128 DBIx::Class::Carp - Provides advanced Carp::Clan-like warning functions for DBIx::Class internals
132 Documentation is lacking on purpose - this an experiment not yet fit for
133 mass consumption. If you use this do not count on any kind of stability,
134 in fact don't even count on this module's continuing existence (it has
135 been noindexed for a reason).
137 In addition to the classic interface:
139 use DBIx::Class::Carp '^DBIx::Class'
141 this module also supports a class-data based way to specify the exclusion
142 regex. A message is only carped from a callsite that matches neither the
143 closed over string, nor the value of L</_skip_namespace_frames> as declared
144 on any callframe already skipped due to the same mechanism. This is to ensure
145 that intermediate callsites can declare their own additional skip-namespaces.
147 =head1 CLASS ATTRIBUTES
149 =head2 _skip_namespace_frames
151 A classdata attribute holding the stringified regex matching callsites that
152 should be skipped by the carp methods below. An empty string C<q{}> is treated
153 like no setting/C<undef> (the distinction is necessary due to semantics of the
154 class data accessors provided by L<Class::Accessor::Grouped>)
156 =head1 EXPORTED FUNCTIONS
158 This module export the following 3 functions. Only warning related C<carp*>
159 is being handled here, for C<croak>-ing you must use
160 L<DBIx::Class::Schema/throw_exception> or L<DBIx::Class::Exception>.
164 Carps message with the file/line of the first callsite not matching
165 L</_skip_namespace_frames> nor the closed-over arguments to
166 C<use DBIx::Class::Carp>.
170 Like L</carp> but warns once for every distinct callsite (subject to the
171 same ruleset as L</carp>).
175 Like L</carp> but warns only once for the life of the perl interpreter
176 (regardless of callsite).