1 package DBIx::Class::Carp;
6 # This is here instead of DBIx::Class because of load-order issues
8 ## FIXME FIXME FIXME - something is tripping up V::M on 5.8.1, leading
9 # to segfaults. When n::c/B::H::EndOfScope is rewritten in terms of tie()
10 # see if this starts working
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 my ($ln, $calling) = @f # if empty - nothing matched - full stack
36 ? ( "at $f[1] line $f[2]", $f[3] )
37 : ( Carp::longmess(), '{UNKNOWN}' )
42 $calling =~ /::/ ? "$calling(): " : "$calling: ", # cargo-cult from Carp::Clan
48 @warn = "Warning: something's wrong" unless @warn;
50 # back-compat with Carp::Clan - a warning ending with \n does
51 # not include caller info
54 $warn[-1] =~ /\n$/ ? '' : " $ln\n"
59 my (undef, $skip_pattern) = @_;
62 $skip_pattern = $skip_pattern
63 ? qr/ ^ $into $ | $skip_pattern /xo
69 *{"${into}::carp"} = sub {
71 __find_caller($skip_pattern, $into),
77 *{"${into}::carp_once"} = sub {
82 __find_caller($skip_pattern, $into),
88 *{"${into}::carp_unique"} = sub {
89 my ($ln, $calling) = __find_caller($skip_pattern, $into);
90 my $msg = join ('', $calling, @_);
92 # unique carping with a hidden caller makes no sense
95 return if $seen->{$ln}{$msg};
96 $seen->{$ln}{$msg} = 1;
104 # cleanup after ourselves
105 namespace::clean->import(-cleanee => $into, qw/carp carp_once carp_unique/)
106 ## FIXME FIXME FIXME - something is tripping up V::M on 5.8.1, leading
107 # to segfaults. When n::c/B::H::EndOfScope is rewritten in terms of tie()
108 # see if this starts working
109 unless DBIx::Class::_ENV_::BROKEN_NAMESPACE_CLEAN();
113 die (__PACKAGE__ . " does not implement unimport yet\n");
120 DBIx::Class::Carp - Provides advanced Carp::Clan-like warning functions for DBIx::Class internals
124 Documentation is lacking on purpose - this an experiment not yet fit for
125 mass consumption. If you use this do not count on any kind of stability,
126 in fact don't even count on this module's continuing existence (it has
127 been noindexed for a reason).
129 In addition to the classic interface:
131 use DBIx::Class::Carp '^DBIx::Class'
133 this module also supports a class-data based way to specify the exclusion
134 regex. A message is only carped from a callsite that matches neither the
135 closed over string, nor the value of L</_skip_namespace_frames> as declared
136 on the B<first> callframe origin.
138 =head1 CLASS ATTRIBUTES
140 =head2 _skip_namespace_frames
142 A classdata attribute holding the stringified regex matching callsites that
143 should be skipped by the carp methods below. An empty string C<q{}> is treated
144 like no setting/C<undef> (the distinction is necessary due to semantics of the
145 class data accessors provided by L<Class::Accessor::Grouped>)
147 =head1 EXPORTED FUNCTIONS
149 This module export the following 3 functions. Only warning related C<carp*>
150 is being handled here, for C<croak>-ing you must use
151 L<DBIx::Class::Schema/throw_exception> or L<DBIx::Class::Exception>.
155 Carps message with the file/line of the first callsite not matching
156 L</_skip_namespace_frames> nor the closed-over arguments to
157 C<use DBIx::Class::Carp>.
161 Like L</carp> but warns once for every distinct callsite (subject to the
162 same ruleset as L</carp>).
166 Like L</carp> but warns only once for the life of the perl interpreter
167 (regardless of callsite).